Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all 50112 articles
Browse latest View live

Edit Macro to export filtered data into separate worksheet instead of PDF

$
0
0
Hello,

I have a macro below that currently filters excel data and dumps it into a separate PDF. How can I edit this macro to export the data to another spreadsheet rather than into a PDF?

Thank you


Dim OriginalSheet As Worksheet 'this is just a variable to store the active sheet in case it changes through the process.
Dim AccountNumberSheet As Worksheet 'the name of the sheet we will store our account number list.
Dim UniqueAccountNumberCount As Long 'a count of the number of account numbers in the file.
Dim i As Long 'stores the index for looping.
Dim FilterRangeDef As String 'a string representing the range of cells to be filtered.
Dim FilterRange As Range 'A variable for the range of cells that need to be filtered.
Dim FilterColumn As Integer 'The column you want to filter on. A=1, B=2, C=3 etc.
Dim FileName As String 'The name of the file to be saved.


On Error GoTo cleanup
'********define your filter range here.**********
FilterRangeDef = "A2:AC6261"
FilterColumn = 1
'************************************************

'Start setting some variables and application settings.
Application.EnableEvents = False
Application.ScreenUpdating = False

Set OriginalSheet = ActiveSheet
Set FilterRange = OriginalSheet.Range(FilterRangeDef)

'Add a worksheet for the unique list and copy the unique list in A1
Set AccountNumberSheet = Worksheets.Add
FilterRange.Columns(FilterColumn).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=AccountNumberSheet.Range("A1"), _
CriteriaRange:="", Unique:=True

'Count of the unique values + the header cell
UniqueAccountNumberCount = Application.WorksheetFunction.CountA(AccountNumberSheet.Columns(1))

'If there are unique values start the loop
If UniqueAccountNumberCount >= 1 Then
For i = 2 To UniqueAccountNumberCount
If AccountNumberSheet.Cells(i, 1).Value Like "?*" Then
'Set the filter to the current acocunt
FilterRange.AutoFilter Field:=FilterColumn, _
Criteria1:=AccountNumberSheet.Cells(i, 1).Value
'Create the file name.
FileName = "C:\Notices\parsed\" & AccountNumberSheet.Cells(i, 1).Value & ".pdf"
'export the file to a pdf
On Error Resume Next
OriginalSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=FileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False
On Error GoTo 0

End If
'Close AutoFilter
OriginalSheet.AutoFilterMode = False
Next i
End If

MsgBox "Done"

cleanup:
Application.DisplayAlerts = False
AccountNumberSheet.Delete
Application.DisplayAlerts = True

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Search and Update a Worksheet

$
0
0
Hi there,

I have a userform for co-workers to use as a way of searching an ever growing worksheet, make changes and
update the result in question. I have been searching for the site for similar posts and was able to find something that
sounds exactly what I need to do (thank you Warship), and have adapted it, but it isn't quite right.

My userform has three textboxes that are filled in by the user. Then I have a ListBox used to display the found rows.
Finally, the user selects one of the found items. The selection populates texboxes and the data can be changed.

I have 2 command buttons on the form - one to execute the search and the other to update any record that has been
modified.

So far, I can see that the search executes correctly, but the ListBox doesn't show the results.

I have included the code that I have.

Any help would be greatly appreciated

fbiasi

Code:


Option Explicit
    Dim rgData As Range
    Dim rgResults As Range
    Dim ListRow As Long
    Dim SkipEvent As Boolean
    Dim shData As Worksheet

Private Sub buttSrch_Click()
    Dim shCurrent As Worksheet
    Dim shResults As Worksheet
    Dim found As Range
    Dim firstFound As String
    Dim SrchCol_1 As String
    Dim SrchCol_2 As String
    Dim SrchCol_3 As String
    Dim r As Long
   
    If tbSrch1 = "" And tbSrch2 = "" And tbSrch3 = "" Then Exit Sub
   
    Set shData = Sheets("List") 'change to suit
    Set rgData = shData.Cells.CurrentRegion
    Set rgData = rgData.Offset(1, 0).Resize(rgData.Rows.Count - 1, rgData.Columns.Count)
   
    Set shCurrent = ActiveSheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Results").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Results"
    Set shResults = Sheets("Results")
    With shResults
        .Cells(1, 1) = "DataRow"
        .Cells(1, 2) = "Header 1" 'change to suit
        .Cells(1, 3) = "Header 2"
        .Cells(1, 4) = "Header 3"
        .Cells(1, 5) = "Header 4"
        .Cells(1, 6) = "Header 5"
        .Cells(1, 7) = "Header 6"
        .Cells(1, 8) = "Header 7"
        .Cells(1, 9) = "Header 8"
        .Cells(1, 10) = "Header 9"
    End With
   
    'columns to search thru - change to suit
    SrchCol_1 = "A"
    SrchCol_2 = "B"
    SrchCol_3 = "C"
   
    lbResList.ListIndex = -1
    tbResCol1 = ""
    tbResCol2 = ""
    tbResCol3 = ""
    tbResCol4 = ""
    tbResCol5 = ""
    tbResCol6 = ""
    tbResCol7 = ""
    tbResCol8 = ""
    tbResCol9 = ""
   
    r = 1
    If tbSrch1 <> "" Then
        With rgData.Columns(SrchCol_1)
            Set found = .Find(tbSrch1, rgData.Cells(rgData.Rows.Count, SrchCol_1))
            If Not found Is Nothing Then
                firstFound = found.Address
                Do
                    r = r + 1
                    found.EntireRow.Copy shResults.Cells(r, 1)
                    shResults.Cells(r, 1).Insert Shift:=xlToRight
                    shResults.Cells(r, 1) = found.Row
                    Set found = .FindNext(found)
                Loop While Not found Is Nothing And found.Address <> firstFound
            End If
        End With
    End If
    If tbSrch2 <> "" Then
        With rgData.Columns(SrchCol_2)
            Set found = .Find(tbSrch2, rgData.Cells(rgData.Rows.Count, SrchCol_2))
            If Not found Is Nothing Then
                firstFound = found.Address
                Do
                    r = r + 1
                    found.EntireRow.Copy shResults.Cells(r, 1)
                    shResults.Cells(r, 1).Insert Shift:=xlToRight
                    shResults.Cells(r, 1) = found.Row
                    Set found = .FindNext(found)
                Loop While Not found Is Nothing And found.Address <> firstFound
            End If
        End With
    End If
    If tbSrch3 <> "" Then
        With rgData.Columns(SrchCol_3)
            Set found = .Find(tbSrch3, rgData.Cells(rgData.Rows.Count, SrchCol_3))
            If Not found Is Nothing Then
                firstFound = found.Address
                Do
                    r = r + 1
                    found.EntireRow.Copy shResults.Cells(r, 1)
                    shResults.Cells(r, 1).Insert Shift:=xlToRight
                    shResults.Cells(r, 1) = found.Row
                    Set found = .FindNext(found)
                Loop While Not found Is Nothing And found.Address <> firstFound
            End If
        End With
    End If
    If r = 1 Then
        lbResList.RowSource = ""
        MsgBox "No Results"
    Else
        Set rgResults = shResults.Cells.CurrentRegion
        Set rgResults = rgResults.Offset(1, 0).Resize(rgResults.Rows.Count - 1, rgResults.Columns.Count)
        rgResults.RemoveDuplicates Columns:=Array(1), Header:=xlNo
        Set rgResults = shResults.Cells.CurrentRegion
        Set rgResults = rgResults.Offset(1, 0).Resize(rgResults.Rows.Count - 1, rgResults.Columns.Count)
        ActiveWorkbook.Names.Add Name:="rgResults", RefersTo:=rgResults
        lbResList.RowSource = "rgResults"
    End If
   
    shCurrent.Activate
    Application.ScreenUpdating = True
End Sub

Private Sub buttUpdate_Click()
    Dim DataRow As Long
    On Error Resume Next
    DataRow = lbResList.List(lbResList.ListIndex, 0)
    On Error GoTo 0
    If DataRow = 0 Then Exit Sub
    SkipEvent = True
        If tbResCol1 = "" And tbResCol2 = "" And tbResCol3 = "" And _
          tbResCol4 = "" And tbResCol5 = "" And tbResCol6 = "" And _
          tbResCol7 = "" And tbResCol8 = "" And tbResCol9 = "" Then
           
            If MsgBox("Delete Entire Record?", vbExclamation + vbYesNo, "Confirm") = vbNo Then
            “SkipEvent = False”
                Exit Sub
           
            Else
                shData.Rows(DataRow).EntireRow.Delete
                ListRow = lbResList.ListIndex + 1
                rgResults.Rows(ListRow).EntireRow.Delete
            End If
        Else
            If MsgBox("Do updates?", vbExclamation + vbYesNo, "Confirm") = vbNo Then
            “SkipEvent = False”
                Exit Sub
           
            Else
                With shData
                    .Cells(DataRow, 1) = tbResCol1
                    .Cells(DataRow, 2) = tbResCol2
                    .Cells(DataRow, 3) = tbResCol3
                    .Cells(DataRow, 4) = tbResCol4
                    .Cells(DataRow, 5) = tbResCol5
                    .Cells(DataRow, 6) = tbResCol6
                    .Cells(DataRow, 7) = tbResCol7
                    .Cells(DataRow, 8) = tbResCol8
                    .Cells(DataRow, 9) = tbResCol9
                End With
                With rgResults
                    ListRow = lbResList.ListIndex + 1
                    .Cells(ListRow, 2) = tbResCol1
                    .Cells(ListRow, 3) = tbResCol2
                    .Cells(ListRow, 4) = tbResCol3
                    .Cells(ListRow, 5) = tbResCol4
                    .Cells(ListRow, 6) = tbResCol5
                    .Cells(ListRow, 7) = tbResCol6
                    .Cells(ListRow, 8) = tbResCol7
                    .Cells(ListRow, 9) = tbResCol8
                    .Cells(ListRow, 10) = tbResCol9
                End With
            End If
        End If
    SkipEvent = False
End Sub

Private Sub lbResList_Click()
    If SkipEvent Then Exit Sub
    With lbResList
        ListRow = .ListIndex
        tbResCol1 = .List(ListRow, 1)
        tbResCol2 = .List(ListRow, 2)
        tbResCol3 = .List(ListRow, 3)
        tbResCol4 = .List(ListRow, 4)
        tbResCol5 = .List(ListRow, 5)
        tbResCol6 = .List(ListRow, 6)
        tbResCol7 = .List(ListRow, 7)
        tbResCol8 = .List(ListRow, 8)
        tbResCol9 = .List(ListRow, 9)
    End With

End Sub

Using user inputed information in the file

$
0
0
This should be super simple. I am looking for that will open a "Input Box" where the end user has two options one they enter some text and press enter or they click a button to end.

In the case they enter text and press enter-- the text they entered will be inputed into cell A4 on Sheet1 and then run a quick second macro which i already have at the end of that macro it will recall this one to the front another input.

In the case the click the button to end then the "Input Box" will just disappear and nothing else will run and the user will find themselves on Sheet2 with Cell A1 selected.

I knew how to do this at one time but I am drawing a blank. I keep saying "Input Box" because I feel that this is the right command to use but have not used it in so long I am unsure of the how to write what I want.

format multiple textboxes at one time on initialize

$
0
0
I have a total of 648 textboxes on my form. Some of the textboxes allow for char values, some numeric and some monetary. The problem I am running into is with the monetary. I am trying to say on initialize, I want to autoformat 208 of these textboxes to $0.00 and when the users puts in an actual amount it changes to $100.00 or whatever the amount. It would be ideal to just have the textbox blank and when the users puts in something it is formatted automatically to $100.00. Just like I would if I were formatting an Excel column or cell. Here is my code so far: (hopefully no typos in code. Cannot copy and paste as using home computer. My work computer blocks the excelforum.com site. not sure why)

Code:

private sub userform_initialize()
' populate contract
me.combobox1.list = sheets("contracttype").cells(1,1).currentregion.columns(1).value

'populate implant category
me.combobox2.list = sheets("implantcategory").cells(1,1).currentregion.columns(1).value

'format dollar values
textbox128.text = format(textbox128.text, "$0.00")
textbox129.text = format(textbox129.text, "$0.00")
textbox130.text = format(textbox130.text, "$0.00")
textbox131.text = format(textbox131.text, "$0.00")
textbox132.text = format(textbox132.text, "$0.00")
textbox133.text = format(textbox133.text, "$0.00")
textbox134.text = format(textbox134.text, "$0.00")
textbox135.text = format(textbox135.text, "$0.00")


and so on for all 208 textboxes


'

How to carry over freeze panes function into temporary file from VBA

$
0
0
I have a code below that works great for sending different ranges from the same sheet to different email addresses. It creates a temporary file as the attachment in the email.

One thing that would be great to have is to be able to freeze panes of the temporary file headers. There are the same headers at the start of each range, and it would be nice if each row of headers would have the freeze panes function in each temporary file.

Is this possible? If not for multiple files, can the first row of headers (row 1) follow over to the first temporary file?

Any help would be greatly appreciated.

[SOLVED] Delete all slicers in activesheet

$
0
0
I have 30+ sheets with 1 pivot table and 3 slicers in each sheet.

In VBA, how do I delete all slicers in an activesheet (not all worksheets, just the activesheet)?

Move row data to a specific sheet if column contains specific word

$
0
0
hi

I have a sheet called 'TimeRecorded' which will contain lots of rows of data.

If a row contains 'invoice' in column H, then the data in that row, preferably as far as column H, should be moved to the next blank row in a sheet called 'Archived'.

I would like the macro to move every row that contains 'Invoice' in column H to be moved.

All help is appreciated as I'm floundering!

Thanks in advance.

Kenneth

Macro for a Summary of multiple worksheets

$
0
0
Hey Everyone,

I am familiar with the basics of Excel, but not with Macros or VBA's.
I am trying to create one Excel file for accounting purposes. Within this file I want to create a worksheet for each customer I have in my store. On this sheet I want to list my costs and their payments. I would like to then create a summary sheet which adds all of the individual customer sheets together. Now this is easy to do manually, but what I need to create is an automation (Macro I assume) that does the following:
I add a new sheet and name it after the new customer. The Macro automatically adds that sheet into the formula for the summary sheet. This way may secretary only needs to activate the macro, which will copy a sheet and automatically update the summary page to include this newly copied sheet and all its information. Now the process for automating projected costs and profits is very easy and requires nothing more but to activate the macro.

Any help would be appreciated. I couldn't get it to work.

[SOLVED] disable conversion of number to date when copying from userform to worksheet

$
0
0
I have a worksheet that has a userform with many textboxes. This userform has a button as well that saves the data entered in the textboxes into a different workbook. All goes well except.... the textboxes that have numerical values get converted to date on the worksheet. I dont want that to happen. If there is number in a textbox then it should store it as the same number in the worksheet. E.g if 14 entered in the textbox it should store 14 in the assigned worksheet.

I tried a few tweaks but unfortunately none worked. Would be grateful if any help could be extended.

Thanks.

Display server message to user after POST file upload

$
0
0
I'm using VBA to upload the open workbook to app.box URL which is working great! Since I'm pretty new to VBA, I can't figure out how to get the website server to return and display the sucess/failed message to the user. I used the Post upload module from this awesome tutorial, but I can't figure out how to return the message to the user. Any suggestions?

I did figure out that on the website there is an "id="after_upload_message", not sure if that helps. My code is below.

Code:

Private Sub pvPostFile(sUrl As String, sFileName As String, Optional ByVal bAsync As Boolean)
    Const STR_BOUNDARY  As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
    Dim nFile          As Integer
    Dim baBuffer()      As Byte
    Dim sPostData      As String
 
    TempFilePath = Environ$("temp") & "\"
    TempFileName = Range("Date") & "_" & Range("Name") & ".xlsm"

'Status window to user
    With FrmStatus1
      .StartUpPosition = 0
      .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
      .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
      .Show
    End With
    Load FrmStatus1
    FrmStatus1.Label1.Caption = "Submitting..."
    FrmStatus1.Show
    FrmStatus1.Repaint

'Start by saving a copy of the open file in the temp folder using with a nice naming convention
    ActiveWorkbook.SaveCopyAs TempFilePath & TempFileName

'Define the file to be uploaded, and the Box URL
    sFileName = TempFilePath & TempFileName
    sUrl = "https://upload.box.com/api/1.0/upload/'[I redacted the remainder]
 
'--- read file
    nFile = FreeFile
    Open sFileName For Binary Access Read As nFile
    If LOF(nFile) > 0 Then
        ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
        Get nFile, , baBuffer
        sPostData = StrConv(baBuffer, vbUnicode)
    End If
    Close nFile
'--- prepare body
    sPostData = "--" & STR_BOUNDARY & vbCrLf & _
        "Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
        "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
        sPostData & vbCrLf & _
        "--" & STR_BOUNDARY & "--"
'--- post
    With CreateObject("Microsoft.XMLHTTP")
        .Open "POST", sUrl, bAsync
        .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
        .Send pvToByteArray(sPostData)
    End With
   
'ADD SOME CODE HERE TO RETURN THE WEBSITE MESSAGE
'On the Box widget page it's named:  id="after_upload_message"

' Deletes the temporary file from the Temporary folder
    Application.DisplayAlerts = False
    Kill TempFilePath & TempFileName
    Application.DisplayAlerts = True

'Give sucess message
' This is based on an assumption since I don't know yet how to return the message from the server
' I assume that Excel will time out if something goes wrong, otherwise, the user gets the sucess message
    Load FrmStatus1
    FrmStatus1.Label1.Caption = "Finished!"
    FrmStatus1.Repaint
    Application.Wait (Now + TimeValue("0:00:2"))
    FrmStatus1.Hide
    Unload FrmStatus1

 
End Sub
Private Function pvToByteArray(sText As String) As Byte()
    pvToByteArray = StrConv(sText, vbFromUnicode)
End Function

[SOLVED] Automatic update of a "sum" cell when row inserted not working

$
0
0
Hello,

Another in the simple things that are causing me grief series :(

SO, I have a series of rows with data (say A1:A5) and in cell A6 I have a "=sum(A1:A5) formula.

If I manually insert a new row after A3 for example, excel happily changes my sum formula to include the new row.

However, using the code snippet below in a macro happily inserts the row but the sum formula isn't updated???:confused:

Anybody spot what i am clearly not doing correctly please

Code:

        Rows(next_daily_row).Select
        Selection.Copy
' add in new row
        Selection.Insert Shift:=xlDown
        Application.CutCopyMode = False

Thanks in advance

Jmac1947

How can I perform a conditional test based on the sum a row of cells using VBA

$
0
0
Hi

There is no doubt an exceedingly simple answer to this question however using VBA script to perform basic mathematical calculations is not something I am familiar with.

In the past I have used VBA script to change column with size based on cell values as per follows:

Code:

If Range("A1").Value = "Some Criteria" Then
 Columns("A").ColumnWidth = 0
 Else
 Columns("Q").ColumnWidth = 20
 End If

Now I wish to change row size in a similar fashion only the criteria will be a maths function rather than a string in a single cell. The maths function will simply be a sum of cells in a row. I will need to test whether or not the row ads up to a number greater than zero.

To illustrate what I am trying to achieve I have (poorly) written out a rough attempt at the code below:

Code:

If Sum("A1:E1") < 0 Then
 Rows("1").RowHeight = 0
 Else
 Rows("1").RowHeight = 20
 End If

I am unsure how the syntax works for this, I considered defining the range as a string first so I could test the value of a single variable (by defined name) rather than directly referencing the row of cells in the formula. As this code needs to be repeated many time for many rows the simplest solution would be b

An assistance greatly appreciated.

Michael.

Setting range in vba based on vlookup criteria

$
0
0
Hi,

Consider the following Table;

----- A------------B
1---Blue ----------23
2---Black----------45
3---Grey ---------32
4---Pink ----------60

I set range as follows;
Code:

Set rngData = .Range("B3").Resize(1, Sheet1.Range("E5"))
I am just concerned with red part of above code. Istead of manually setting it as B3 I want it to be a cell in column B in front of "Grey" in column A, thus it would automatically become B3. It is something like vlookup.

I hope I explained my problem for your understanding, but if not, kindly let me know so I may redraft my problem.

Thank you all

Macro to compare colors in cell and type result

$
0
0
Hello sorry for bad english,

like u see in attachment i have products in cells wich are painted in different colors. I need to compare two numbers of different product, and write result to column "Type D,C,B". If one of two products is without color/white or they are not the same color then result is always "D", if both products/cells have same color and different number then results is "C", if the color and number is the same then result is "B"

Below cell B2 I will write numbers by hand, when I finish and start macro it will compare first cell B2 and B3 and write result to C3, then compare B3 and B4 and write result to C4 and do that until there is any number in column B:B.

Hope u can help me . :)

Tnx
Attached Files

Column cells not updating

$
0
0
The below code evaluate certain conditions so my Range("TPC[CCProduction-S]") can get a value. The code does the work, however, my Range("TPC[CCProduction-S]") sticks to the very first result.
Is this code actually a good approach? can I improve it? suggestions...
There is a copy of my project attached to this thread. Thanks.

[CODE]
PHP Code:

Sub CCProductionPS()
Dim SawPoweredBy As Range
Set SawPoweredBy 
Range("TPC[Saw Power" Chr(10) & "Source]")
Dim SConfiguration As Range
Set SConfiguration 
Range("TPC[Section" Chr(10) & "Configuration]")
Dim CCProduction As Range
Set CCProductionS 
Range("TPC[CCProduction-S]")

    If 
SawPoweredBy.Value "Electricity" And SConfiguration.Value "Short Run" Then
       CCProductionS
.FormulaR1C1 "=INDEX(PR[E-Short Run],MATCH([CODE],PR[CODE],0))"
        
Else
            If 
SawPoweredBy.Value "Electricity" And SConfiguration.Value "Long Run" Then
               CCProductionS
.FormulaR1C1 "=INDEX(PR[E-Long Run],MATCH([CODE],PR[CODE],0))"
                
Else
                    If 
SawPoweredBy.Value "Gasoline" And SConfiguration.Value "Short Run" Then
                       CCProductionS
.FormulaR1C1 "=INDEX(PR[G-Short Run],MATCH([CODE],PR[CODE],0))"
                        
Else
                            If 
SawPoweredBy.Value "Gasoline" And SConfiguration.Value "Long Run" Then
                               CCProductionS
.FormulaR1C1 "=INDEX(PR[G-Long Run],MATCH([CODE],PR[CODE],0))"
                               
Else
                                   If 
SawPoweredBy.Value "Diesel" And SConfiguration.Value "Short Run" Then
                                      CCProductionS
.FormulaR1C1 "=INDEX(PR[D-Short Run],MATCH([CODE],PR[CODE],0))"
                                      
Else
                                          If 
SawPoweredBy.Value "Diesel" And SConfiguration.Value "Long Run" Then
                                             CCProductionS
.FormulaR1C1 "=INDEX(PR[D-Long Run],MATCH([CODE],PR[CODE],0))"
                                          
End If
                                    
End If
                            
End If
                    
End If
            
End If
    
End If
End Sub 

Attached Files

User Defined function to extract information from closed file

$
0
0
Hi,

Herewith I attached a sample excel file.

Structure file which i attached herewith include all the cost center details. normally it is a big file contain more than 1000 cost center details.
Structure File.xlsx
If i want a cost center name for some cost center code, i have to open this file and find a specific name.

What i plan is develop a macro function called "CC".

If I type =CC("D232") I need to print cost center name for D232.

But the problem is i don't want to open the structure file, without open that file, when i type this function i need a result.

This is not only for me... if if i write this it will be helpful for entire team....

Thanks in advance.
Janagan

Loop and find specific value or misc value, if misc then not equal to certain values

$
0
0
this is working fine however, if rr = "misc" then the macro should look for all ccode values not equal to "0305", "0385" or "0399", not quite sure how to code that

I get the rr value with the code below:

Code:

If ms.Buttons(Application.Caller).Name = "recs0305" Then rr = "0305"
 If ms.Buttons(Application.Caller).Name = "recs0385" Then rr = "0385"
 If ms.Buttons(Application.Caller).Name = "recs0399" Then rr = "0399"
 If ms.Buttons(Application.Caller).Name = "recsmisc" Then rr = "misc"

there is a loop that loops through values in the B colum where rev is a worksheet
if rr = misc then I want it to pull all values that are NOT "0305", "0385", or "0399"

Code:

ccode = Left(rev.Range("B" & Lrow).Value, 4)
If .Value <> "" And ccode = rr Then


any insight would be appreciated

Insert additonal rows into multiple files in a folder based on Master Template(Old file)

$
0
0
Hi all,

Basically, I'm looking to standardize the rate cards I have. So the code JBeaucaire supplied helped me out for the task at the time, however, we have now updated the Rate Card and as a result I have been tasked with updating all our current ones (typical). Can anybody help?

The Task

FileA.xlsx is the original file that contains the old "Cover Page" which has now been altered, to include extra rows, which can be seen in FileB.xlsx.

Is there a way to run a macro that will insert these extra rows with titles into all of the FileA.xlsx files (old ones) based on FileB.xlsx format without losing any data?

Yes the additional "new" rows will still need to be populated with the relevant data but that I'm afraid that will need to be done manually (me) as each Rate Card is verified and peer reviewed (them).
FileB.xlsxFileA.xlsx

Now the cheeky bit....

Would it be possible to build into the code the ability for the user (me) to click "run" so that a folder selection box pops up to select the folder rather than me having to cut and paste the folder destination into the code all the time?

The above is a big ask for me but hoping it's not too big for the gurus out there...

Thanking you in advance.

Kind regards,

Mad-dog

Use VLOOKUP function in macro with Variable Name for Lookup value

$
0
0
Hi Friends,

I used VLookup function in macro. Lookup value is a variable name. I don't know how to use variable name inside of VLOOKUP function.
Use VLOOKUP function in macro with Variable Name for Lookup value

Function CC(CName As String)

ActiveCell.FormulaR1C1 = "=VLOOKUP(cname,'[Structure File.xlsx]Sheet1'!C1:C3,2,FALSE)"

End Function

Please tell me how to use CName variable inside of Vlookup funtion.

Thanks

Range("B" & Rows.Count).End(3)(2).select

$
0
0
what is this Range("B" & Rows.Count).End(3)(2).select please explain?
Viewing all 50112 articles
Browse latest View live