Home > Blockchain >  please help me to create a loop for this vba code
please help me to create a loop for this vba code

Time:11-25

I have 2 sheets,sourcesheet and acct sheet. From sourceSheet I need to copy the values from sourceSheet.Range(Cells(14, 3),Cells(14, 8)) to AcctSheet.range(Cells(2, 11),Cells(7, 11)), however is each cell from sourcesheet is distinct matched to acctsheet, in such a way that

sourceSheet.Cells(14, 3) = AcctSheet.Cells(2, 11)
sourceSheet.Cells(14, 4) = AcctSheet.Cells(3, 11)
sourceSheet.Cells(14, 5) = AcctSheet.Cells(4, 11) and so on until
sourceSheet.Cells(14, 8) = AcctSheet.Cells(7, 11)

full code is here, but hoping to loop this one.

sourceSheet.Activate
    'EQ
    If IsEmpty(sourceSheet.Cells(14, 3).Value) Then
        AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 3).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(14, 3).Value 
    ElseIf sourceSheet.Cells(14, 3).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'WS
    If IsEmpty(sourceSheet.Cells(14, 4).Value) Then
        AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 4).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(14, 4).Value 
    ElseIf sourceSheet.Cells(14, 4).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'TO
    If IsEmpty(sourceSheet.Cells(14, 5).Value) Then
        AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 5).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(14, 5).Value 
    ElseIf sourceSheet.Cells(14, 5).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'FL
    If IsEmpty(sourceSheet.Cells(14, 6).Value) Then
        AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 6).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(14, 6).Value 
    ElseIf sourceSheet.Cells(14, 6).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'FR
    If IsEmpty(sourceSheet.Cells(14, 7).Value) Then
        AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 7).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(14, 7).Value 
    ElseIf sourceSheet.Cells(14, 7).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If
    'TR
    If IsEmpty(sourceSheet.Cells(14, 8).Value) Then
        AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value   
    ElseIf sourceSheet.Cells(14, 8).Value < sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(14, 8).Value 
    ElseIf sourceSheet.Cells(14, 8).Value > sourceSheet.Cells(7, 1).Value Then
        AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value   
    End If

CodePudding user response:

Is something like this what you are looking for?

Option Explicit

Sub test()
    Dim sourceSheet As Worksheet, acctSheet As Worksheet
    Dim i As Long
    Dim sourceCell As Range, targetCell As Range, defaultCell As Range
    
    Set defaultCell = sourceSheet.Cells(7, 1)
    
    For i = 3 To 8
    
        Set sourceCell = sourceSheet.Cells(14, i)
        Set targetCell = acctSheet.Cells(i - 1, 11)
        
        If IsEmpty(sourceCell) Then
            targetCell.Value2 = sourceCell.Value2
        ElseIf sourceCell.Value2 < defaultCell.Value2 Then
            targetCell.Value2 = sourceCell.Value2
        ElseIf sourceCell.Value2 > defaultCell.Value2 Then
            targetCell.Value2 = defaultCell.Value2
        End If
        
    Next i
    
End Sub

Strictly speaking, I don't think you need to include .Value2 after every cell, as VBA kinda uses that as the default when reading the code, but it doesn't hurt.

Using variables for the cell references isn't strictly necessary either, but I find it easier, especially if I need to edit the cell references later.

  • Related