Ace16150s
Ace16150s

Reputation: 97

MS Excel VBA - Looping through columns and rows

Hello stackoverflow community,

I must confess I primarily code within MS Access and have very limited experience of MS Excel VBA.

My current objective is this, I have an "Expense Report" being sent to me with deductions, this report has many columns with different account names that may be populated or may be null.

My first step will be to start on the first record (Row 14; Column A-K contains personal info regarding the deduction) then skip to the first deduction account (deduction accounts start at column L and span to column DG) checking if each cell is null, if it is then keep moving right,If there is a value present, I need to copy it into an external workbook "Payroll Template" starting at row 2 (Column J for the deduction itself), as well as copy some personal info from the original row in the "Expense Report" related to that deduction (currRow: Column C,E,F from "Expense Report" to "Payroll Template" Columns B,C,D).

Then move to the right until the next cell contains a value, and repeat this process on a new row in the "Payroll Template". Once the last column (DG) has been executed I want to move to the next row (row 15) and start the process again all the way until the "LastRow" in my "Used Range".

I greatly appreciate any feedback, explanations, or links that may point me towards my goal. Thank you in advance for taking the time to read though this!

Current state of code:

`< Sub LoadIntoPayrollTemplate()
Dim rng As Range
Dim currRow As Integer
Dim UsedRng As Range
Dim LastRow As Long



Set UsedRng = ActiveSheet.UsedRange
currRow = 14


Set wb = ActiveWorkbook '"Expense Report"
Set wb2 = MyFilepath '"Payroll Template"


'Copied from another procedure, trying to use as reference         
LastRow = rng(rng.Cells.Count).Row
Range("A14").Select
Do Until ActiveCell.Row = LastRow + 1
    If (ActiveCell.Value) <> prev Then

        currRow = currRow + 1

    End If

    ActiveCell.Offset(1, 0).Select
Loop

With Worksheets("Collections")
    lstRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set rng = .Range(.Cells(14, 12), Cells(lstRow, 111))
End With

End Sub>`

Upvotes: 0

Views: 3253

Answers (1)

YowE3K
YowE3K

Reputation: 23994

The following code may do what you are after:

Sub LoadIntoPayrollTemplate()
    Dim currRowIn As Long
    Dim currColIn As Long
    Dim currRowOut As Long
    Dim wb As Workbook
    Dim wb2 As Workbook

    Set wb = ActiveWorkbook '"Expense Report"
    Set wb2 = Workbooks.Open(Filename:=MyFilepath & "\" & "Payroll Template.xlsx")
    'or perhaps
    'Set wb2 = Workbooks.Open(Filename:=wb.path & "\" & "Payroll Template.xlsx")

    With wb.ActiveSheet
        currRowOut = 1
        For currRowIn = 14 To .UsedRange.Row + .UsedRange.Rows.Count - 1
            For currColIn = 12 To 111
                If Not IsEmpty(.Cells(currRowIn, currColIn)) Then
                    currRowOut = currRowOut + 1
                    'I'm not sure which worksheet you want to write the output to
                    'so I have just written it to the first one in Payroll Template
                    wb2.Worksheets(1).Cells(currRowOut, "J").Value = .Cells(currRowIn, currColIn).Value
                    wb2.Worksheets(1).Cells(currRowOut, "B").Value = .Cells(currRowIn, "C").Value
                    wb2.Worksheets(1).Cells(currRowOut, "C").Value = .Cells(currRowIn, "E").Value
                    wb2.Worksheets(1).Cells(currRowOut, "D").Value = .Cells(currRowIn, "F").Value

                End If
            Next
        Next
    End With

    'Save updated Payroll Template
    wb2.Save

End Sub

Upvotes: 1

Related Questions