Macro to copy data based on specific criteria

[howard]

I have the following text and values in E1 to F3

MRTB Bal owing -209562
CMTRQ Bal owing -368012
SRQE Bal owing -30171.3




Where the text to the left in E1 to E3 is the same as Col E from row 8 onwards and col D contains Bal B/FWD, then copy the value in Col F where the text to the left is the same as the text in Col E from row 8 onwards and paste as special values in Col G with the minus sign to removed in the same row as the criteria appears

For eg if BRTB and Bal B/FWD are in row 8 , then paste the value with the minus sign removed in G8


I have tried to write code to do this but only zeroes are being pasted

 Sub CopyBalances_YearEnd()
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim i As Long
    
    ' Set the worksheet you want to work with (Change "Details" to your sheet's name)
    Set ws = ThisWorkbook.Sheets("Details")
    
    ' Find the last row in the worksheet
    LastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    
    ' Loop through each row in the worksheet
    For i = 8 To LastRow ' Assuming data starts from row 8, change if needed
        If InStr(1, ws.Cells(i, "E").Value, "MRTB") > 0 Then
            If InStr(1, ws.Cells(i, "D").Value, "Bal B/FWD") > 0 Then
                ' Copy balance from column F, remove '-' if present, and paste as a value
                ws.Cells(i, "F").Value = Abs(ws.Cells(i, "F").Value)
                ws.Cells(i, "F").Copy
                ws.Cells(i, "G").PasteSpecial Paste:=xlPasteValues
            End If
        ElseIf InStr(1, ws.Cells(i, "E").Value, "CMTRQ") > 0 Then
            If InStr(1, ws.Cells(i, "D").Value, "Bal B/FWD") > 0 Then
                ' Copy balance from column F, remove '-' if present, and paste as a value
                ws.Cells(i, "F").Value = Abs(ws.Cells(i, "F").Value)
                ws.Cells(i, "F").Copy
                ws.Cells(i, "G").PasteSpecial Paste:=xlPasteValues
            End If
        ElseIf InStr(1, ws.Cells(i, "E").Value, "SRQE") > 0 Then
            If InStr(1, ws.Cells(i, "D").Value, "Bal B/FWD") > 0 Then
                ' Copy balance from column F, remove '-' if present, and paste as a value
                ws.Cells(i, "F").Value = Abs(ws.Cells(i, "F").Value)
                ws.Cells(i, "F").Copy
                ws.Cells(i, "G").PasteSpecial Paste:=xlPasteValues
            End If
        End If
    Next i
End Sub

Your assistance in this regard is most appreciated

 

[bebo021999]

Try to attach a sample with XL2BB (or sharing file via gg drive)

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com

 

[howard]

Please find link to sample data

I have shown what is required on sheet "After'

Dropbox

www.dropbox.com

 

[bebo021999]

Please find link to sample data

I have shown what is required on sheet "After'

Dropbox

www.dropbox.com

Sorry there wes no sheet called "After". There is only 1 sheet "Details". Maybe you forgot to create the After sheet.

 

[howard]

My apologies. think I uploaded file before saving

See link below

Savings and Drawing Test File.xls

Shared with Dropbox

www.dropbox.com

 

[bebo021999]

Below code does exactly as per sheet After.
(Though I do not understand why the new output value of columm G are exact old balance in F1:F3! )

Option Explicit
Sub CopyBalance_YearEnd()
Dim lr&, i&, j&, Data, Amount, list, id As String
With Sheets("Details")
    list = .Range("E1:F5").Value  ' criteria range
    lr = .Cells(.Rows.Count, "E").End(xlUp).Row ' last used row
    Data = .Range("D8:E" & lr).Value ' range with criteria data
    Amount = .Range("F8:G" & lr).Value ' range with amount data, need to be changed
    For i = 1 To UBound(Data)
        id = Data(i, 2) & " " & Left(Data(i, 1), 3) & " owing" ' generate string, i.e, "MRTB Bal owing" or "MRTB 100 owing"
        For j = 1 To UBound(list)
            If list(j, 1) = id Then ' if id string exists in criteria range, i.e, "MRTB Bal owing":
                Amount(i, 2) = -list(j, 2) ' replace column G with - F1:F3
                Amount(i, 1) = 0 ' column F = 0
            End If
        Next
    Next
    .Range("F8").Resize(UBound(Amount), 2).Value = Amount
End With
End Sub

 

[howard]

Many thanks for the help. The balance of the rows where Bal B/FWD is in Col D is deleted when starting the new financial year