First of all here's a link to my workbook, uploaded to OneDrive:
https://1drv.ms/x/s!AsQuasddi71ugRSDelemaNIBKazB
I have been trying for the past couple of weeks to develop a code, to search out a Header in a column, to determine the range of what I want to copy.
The result I get in Excel: To find column letter for "No.":
=SUBSTITUTE(ADDRESS(1;MATCH("No.";1:1;0);4);"1";"")
Result: B
To find columns header and first row for "No.":
=ADDRESS(1;MATCH("No.";1:1;0);4)
Result: B1
To find column letter for "Prepayment Amount excl VAT":
=SUBSTITUTE(ADDRESS(1;MATCH("Prepayment Amount excl VAT";1:1;0);4);"1";"")
Result: L
To find columns header and first row for "Prepayment Amount excl VAT":
=ADDRESS(1;MATCH("Prepayment Amount excl VAT";1:1;0);4)
Result: L1
Within the excel file, I have two modules... Module1 is working based on the columns, meaning it will always copy column B and L in Sheet 1, and column A and B in sheet 2...
In Module2 I have been trying to create a macro, which should navigate on the Header name of the column, and return cell B1 and column B to declare the column as:
sht.Range("B1:B" & LastRow).Copy
Otherwise I would like to assign the Substitute, Address, Match formula to a variable, which I want to replace "B1" and "B" with...
At the moment I get a lot of errors...
Am I able to make the macro use the result of my substitute, address, match formula, to replace "B1" and "B" in sht.Range("B1:B" & LastRow).Copy
?
Please let me know, if you have an idea, of how I can correct the macro to do as I want it to :)
My macro is as listed below:
Sub CopyPasteDataLookingForHeader()
Dim sht, sht2, sht3 As Worksheet
Dim i, LastRow, LastRow2 As Long
Dim Number, NumberOne, Prepay, PrepayOne As Variant
Set sht = Sheets("Sales List")
Set sht2 = Sheets("Match Sales List and Pivot")
Set sht3 = Sheets("Pivot of Prepayment account")
Number = Application.WorksheetFunction.Substitute(sht.Range("1:1").Address(1, Application.WorksheetFunction.Match("No.", sht.Range("1:1"), 0), 4), 1, "")
NumberOne = sht.Range("1:1").Address(1, Application.WorksheetFunction.Match("No.", sht.Range("1:1"), 0), 4)
Prepay = Application.WorksheetFunction.Substitute(sht.Range("1:1").Address(1, Application.WorksheetFunction.Match("Prepayment Amount excl VAT", sht.Range("1:1"), 0), 4), "1", "")
PrepayOne = sht.Range("1:1").Address(1, Application.WorksheetFunction.Match("Prepayment Amount excl VAT", sht.Range("1:1"), 0), 4)
LastRow = sht.Cells(sht.Rows.Count, Number).End(xlUp).Row
LastRow2 = sht3.Cells(sht3.Rows.Count, "B").End(xlUp).Row
Dim rng1, rng2 As Range
rng1 = "NumberOne:Number"
rng2 = "PrepayOne:Prepay"
sht.Range(rng1 & LastRow).Copy
sht2.Activate
Range("D1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
sht.Range(rng2 & LastRow).Copy
sht2.Activate
Range("E1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
sht3.Range("A1:A" & LastRow2).Copy
sht2.Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
sht3.Range("B1:B" & LastRow2).Copy
sht2.Activate
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'------------------------------------------
Columns("A:E").ColumnWidth = 25
End Sub
When referencing variables, don't put them in quotations. Right now, the code has rng1 = "NumberOne:Number"
, which Excel interprets literally. You'll want to concatenate the pieces of text to form the range. Try:
Dim FindNo, Number, NumberOne, FindPrepay, Prepay, PrepayOne As String
FindNo = Sht.Range("1:1").Find("No.").Address(False, False, xlA1)
Number = Application.WorksheetFunction.Substitute(FindNo, 1, "")
NumberOne = FindNo
FindPrepay = Sht.Range("1:1").Find("Prepayment Amount excl VAT").Address(False, False, xlA1)
Prepay = Application.WorksheetFunction.Substitute(FindPrepay, 1, "")
PrepayOne = FindPrepay
rng1 = NumberOne & ":" & Number & LastRow
rng2 = PrepayOne & ":" & Prepay & LastRow
This also uses the VBA Range.Find
, and Address
methods, instead of calling worksheet functions.