Dynamic Autofill

Hanes109 · Sep 14th 2021

Hi, I'm struck in VBA code to find number of rows after fetching the data from another workbook and autofill.

Macro placed in separate file Dumhost.xlsm( Macro workbook) to update Dummy format.csv (File1) from Xando.csv work (file2).

Code

Sub Dum()
Dim FName, wb1 As Workbook, wb2 As Workbook
Dim x, y, i As Long, ii As Long, iii As Long, s As String
Dim Lastrow As Long
FName = Application.GetOpenFilename("excel files,*.csv", , "Select Dummy format & Xando file", , True)
If Not IsArray(FName) Then Exit Sub
If UBound(FName) = 2 Then
Set wb1 = Workbooks.Open(FName(1))
'wb1=Dummy format
Set wb2 = Workbooks.Open(FName(2))
'wb2=Xando
Lastrow = wb1.Range("B" & Rows.Count).End(xlUp).Row


Else
MsgBox "Please select DnD format & L3 file", 16, "To Update DND format"
Exit Sub
End If


Application.ScreenUpdating = 0
wb2.Sheets(1).Range("A2:A5000").Copy _
wb1.Sheets(1).Range("E2")
wb2.Sheets(1).Range("B2:B5000").Copy _
wb1.Sheets(1).Range("F2")
wb2.Sheets(1).Range("D2:D5000").Copy _
wb1.Sheets(1).Range("H2")
wb2.Sheets(1).Range("ABV2:ABV5000").Copy _
wb1.Sheets(1).Range("B2")
wb2.Sheets(1).Range("ABU2:ABU5000").Copy _
wb1.Sheets(1).Range("C2")
wb1.Sheets(1).Range("D2").Select
wb1.Sheets(1).Range("D2:D" & Lastrow).FillDown
wb1.Sheets(1).Range("G2").Select
wb1.Sheets(1).Range("G2:G" & Lastrow).FillDown
wb1.Sheets(1).Range("J2").Select
wb1.Sheets(1).Range("J2:J" & Lastrow).FillDown
wb1.Sheets(1).Range("K2").Select
wb1.Sheets(1).Range("K2:K" & Lastrow).FillDown
End Sub

Display More

**royUK** · Sep 14th 2021

Your code finds the last row in wb1.

Is this what you mean?

Code

Sub Dum()
    Dim FName, wb1 As Workbook, wb2 As Workbook
    Dim x, y, i As Long, ii As Long, iii As Long, s As String
    Dim Lastrow As Long
    FName = Application.GetOpenFilename("excel files,*.csv", , "Select Dummy format & Xando file", , True)
    If Not IsArray(FName) Then Exit Sub
    If UBound(FName) = 2 Then
        Set wb1 = Workbooks.Open(FName(1))
        'wb1=Dummy format
        Set wb2 = Workbooks.Open(FName(2))
        'wb2=Xando
        Lastrow = wb1.Range("B" & Rows.Count).End(xlUp).Row
        
    Else
        MsgBox "Please select DnD format & L3 file", 16, "To Update DND format"
        Exit Sub
    End If
    
    Lastrow = wb1.Range("B" & Rows.Count).End(xlUp).Row
    
    Application.ScreenUpdating = 0
    With wb1.Sheets(1)
        wb2.Sheets(1).Range("A2:A5000").Copy .Range("E2")
        wb2.Sheets(1).Range("B2:B5000").Copy .Range("F2")
        wb2.Sheets(1).Range("D2:D5000").Copy .Range("H2")
        wb2.Sheets(1).Range("ABV2:ABV5000").Copy .Range("B2")
        wb2.Sheets(1).Range("ABU2:ABU5000").Copy .Range("C2")
        .Range("D2:D" & Lastrow).FillDown
        .Range("G2:G" & Lastrow).FillDown
        .Range("J2:J" & Lastrow).FillDown
        .Range("K2:K" & Lastrow).FillDown
        
        MsgBox "Rows count is " & .Range("A2").CurrentRegion.Rows.Count
    End With
End Sub

Display More

Hanes109 · Sep 14th 2021

royUK Yes, Exactly.

I am not sure where to place the below code.. Because column"B" also updates with this code.

Lastrow = wb1.Range("B" & Rows.Count).End(xlUp).Row

Hanes109 · Sep 14th 2021

royUK I get error while running your code..in the same line

Lastrow = wb1.Range("B" & Rows.Count).End(xlUp).Row

**royUK** · Sep 14th 2021

That line of code is from your code not what I added.

What error are you getting?

My code simply tells you how many lines are in the expanded data, I have no idea what you actually want.

Hanes109 · Sep 14th 2021

Run time error 438. Object doesn't support property or this method.

**KjBox** · Sep 14th 2021

You are getting that error because your code is assigning a Range to a Workbook Object, Workbooks do not have Ranges, Worksheets do. You need to specify a Worksheet in that Workbook, for example

Code

Lastrow = wb1.Sheets("Sheet Name" or Sheet Index).Range("B" & Rows.Count).End(xlUp).Row

Hanes109 · Sep 14th 2021

That works perfect!!! Thank you so much KjBox !

**KjBox** · Sep 14th 2021

You're welcome. Thanks for the "Like".

Hanes109 · Sep 17th 2021

Code

.Cells(2, lh) = Application.VLookup(.Cells(2, 7), x, 2, False)

KjBox royUK

I require lookup code to be filled down but its returning same value for all the cells. Can anyone tell me what I'm missing here..

Code

Sub Dumyx()

Dim FName, wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook
Dim Lastrow As Long
Dim Lastrowx As Long
Dim wb2s As Worksheet
Dim rng As Range
Dim x As Range

FName = Application.GetOpenFilename("excel files,*.csv", , "Select DND Format", , True)
If Not IsArray(FName) Then Exit Sub
If UBound(FName) = 1 Then
Set wb1 = Workbooks.Open(FName(1))
Else
MsgBox "Please select DnD format", 16, "Rate Automation - To Update DND format"
Exit Sub
End If

FName = Application.GetOpenFilename("excel files,*.csv", , "Select L3", , True)
If Not IsArray(FName) Then Exit Sub
If UBound(FName) = 1 Then
Set wb2 = Workbooks.Open(FName(1))
Else
MsgBox "Please select L3", 16, "Rate Automation - To Update DND format"
Exit Sub
End If

FName = Application.GetOpenFilename("excel files,*.xlsx", , "Select Input", , True)
If Not IsArray(FName) Then Exit Sub
If UBound(FName) = 1 Then
Set wb3 = Workbooks.Open(FName(1))
Else
MsgBox "Please select Input", 16, "Rate Automation - To Update DND format"
Exit Sub
End If

Set rng = wb1.Sheets(1).Range("A1:P1")
Set delcol = wb1.Sheets(1).Range("A1:P1")
Set delcolx = wb1.Sheets(1).Range("A:P")
Set x = wb3.Sheets(5).Range("B:C")
Set wb2s = wb2.Sheets(1)

Application.ScreenUpdating = False

With wb1.Sheets(1)

Lastrowx = wb2.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row

wb2s.Range("A2:A" & Lastrowx).Copy .Range("E2")
wb2s.Range("B2:B" & Lastrowx).Copy .Range("F2")
wb2s.Range("D2:D" & Lastrowx).Copy .Range("H2")
wb2s.Range("ABV2:ABV" & Lastrowx).Copy .Range("B2")
wb2s.Range("ABU2:ABU" & Lastrowx).Copy .Range("C2")

wb2.Close

Lastrow = wb1.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row

.Range("D2:D" & Lastrow).FillDown
.Range("G2:G" & Lastrow).FillDown
.Range("J2:J" & Lastrow).FillDown
.Range("K2:K" & Lastrow).FillDown

lg = wb1.Sheets(1).Rows("1").Find("destination").Column

.Columns(lg + 1).EntireColumn.Insert Shift:=xlToRight
.Cells(1, lg + 1) = "Country"
.Cells(2, lg + 1).Formula = "=VLOOKUP(F2,XFC:XFD,2,0)"
.Range("G2:G" & Lastrow).FillDown

'lx = wb3.Sheets(5).Range("B:C")
lh = wb1.Sheets(1).Rows("1").Find("free_time").Column

.Cells(2, lh) = Application.VLookup(.Cells(2, 7), x, 2, False)

'.Cells(2, lh).Formula = "=VLOOKUP(G2,,2,0)"
.Range("j2:j" & Lastrow).FillDown

delcolx.CurrentRegion
delcolx.Cells.Copy
delcolx.Cells.PasteSpecial xlPasteValues

Application.CutCopyMode = False

For Each cell In delcol
If cell.Value = "Country" Then cell.EntireColumn.Delete
Next

End With

wb3.Close

End Sub

Display More

**KjBox** · Sep 18th 2021

Thanks for the files you sent.

First you need to change the Input file a bit, replace "Dom Rep" with "Dominican Republic" and replace "Trinidad & Tobago" with "Trinidad and Tobago"

Then change your code to this

Code

Sub Dumyx()
    Dim FName, wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim wb2s As Worksheet, rng As Range, r As Range
    Dim lRow As Long, lCol As Long, i As Long
    
    FName = Application.GetOpenFilename("excel files,*.csv", , "Select DND Format", , True)
    If Not IsArray(FName) Then Exit Sub
    If UBound(FName) = 2 Then
       Set wb1 = Workbooks.Open(FName(1))
       Set wb2 = Workbooks.Open(FName(2))
    Else
       MsgBox "Please select DnD format", 16, "Rate Automation - To Update DND format"
       Exit Sub
    End If
    
    FName = Application.GetOpenFilename("excel files,*.xlsx", , "Select Input", , True)
    If Not IsArray(FName) Then Exit Sub
    If UBound(FName) = 1 Then
       Set wb3 = Workbooks.Open(FName(1))
    Else
       MsgBox "Please select Input", 16, "Rate Automation - To Update DND format"
       Exit Sub
    End If
    
    Set rng = wb1.Sheets(1).Range("A1:P1")
    Set r = wb3.Sheets(5).[b10].CurrentRegion
    Set wb2s = wb2.Sheets(1)
    
    Application.ScreenUpdating = False
    With wb1.Sheets(1)
        Set delcol = .Cells(1).CurrentRegion.Columns(35).Resize(, 8)
        lRow = wb2s.Range("B" & .Rows.Count).End(xlUp).Row
        wb2s.Range("A2:A" & lRow).Copy .Range("E2")
        wb2s.Range("B2:B" & lRow).Copy .Range("F2")
        wb2s.Range("D2:D" & lRow).Copy .Range("H2")
        wb2s.Range("ABV2:ABV" & lRow).Copy .Range("B2")
        wb2s.Range("ABU2:ABU" & lRow).Copy .Range("C2")
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
        .Range("D2:D" & lRow).FillDown
        .Range("G2:G" & lRow).FillDown
        .Range("J2:J" & lRow).FillDown
        .Range("K2:K" & lRow).FillDown
        lCol = .Rows(1).Find("destination").Column
        .Columns(lCol + 1).EntireColumn.Insert Shift:=xlToRight
        .Cells(1, lCol + 1) = "Country"
        .Cells(2, lCol + 1).Formula = "=VLOOKUP(F2,XFC:XFD,2,0)"
        .Range("G2:G" & lRow).FillDown
        lCol = .Rows(1).Find("free_time").Column
        For i = 2 To .Cells(.Rows.Count, 7).End(xlUp).Row
          .Cells(i, lCol) = Application.VLookup(.Cells(i, 7), r, 2, 0)
        Next
        For Each cel In delcol.Cells
            If cel.Value = "Country" Then cel.EntireColumn.Delete
        Next
    End With
    wb2.Close , 0
    wb3.Close , 0
  
End Sub

Display More

Hanes109 · Sep 18th 2021

Thank you so much, KjBox!! It works perfect..!!!

**KjBox** · Sep 18th 2021

You're welcome.

Dynamic Autofill

Participate now!

Share