Rearranging data

Solved/Closed
liwate Posts 1 Registration date Tuesday September 8, 2020 Status Member Last seen September 8, 2020 - Updated on Sep 8, 2020 at 11:58 AM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Sep 10, 2020 at 11:44 AM
Hello,

We work on a lot of data which is not structured the way we are supposed to use it. Am looking for a script in excel to search for a word in a sheet e.g containing "ID" as an example below, in column lets say "C" and copying it to rows in column "B", and the date from column "E" to rows in column "A". Merge debit and credit, but put credit in brackets. Please see before and after results.

1 response

TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Sep 10, 2020 at 11:44 AM
Hi Iwate,

Give the following code a try and see how you like the result:
Sub RunMe()
Dim sSheet, dSheet As Worksheet
Dim x, lRow, mV1, mV2 As Integer

Set sSheet = Sheets("Source")
Set dSheet = Sheets("Destination")
x = 66

dSheet.Select

lRow = Range("A" & Rows.Count).End(xlUp).Row + 1

Do
    Range(Cells(lRow, "B"), Cells(lRow + 2, "B")).Value = Left(sSheet.Range("A" & x), 8)
    Range(Cells(lRow, "C"), Cells(lRow + 2, "C")).Value = Right(sSheet.Range("A" & x), Len(sSheet.Range("A" & x)) - 8)
    Range(Cells(lRow, "A"), Cells(lRow + 2, "A")).Value = sSheet.Range("C" & x)
    Range("D" & lRow).Value = sSheet.Range("A" & x + 2).Value
    If sSheet.Range("B" & x + 2).Value = vbNullString Then
        mV1 = sSheet.Range("C" & x + 2).Value
        Range("E" & lRow).Value = "(" & mV1 & ")"
    Else
        mV2 = sSheet.Range("B" & x + 2).Value
        Range("E" & lRow).Value = mV2
    End If
    Range("D" & lRow + 1).Value = sSheet.Range("A" & x + 3).Value
    If sSheet.Range("B" & x + 3).Value = vbNullString Then
        mV1 = sSheet.Range("C" & x + 3).Value
        Range("E" & lRow + 1).Value = "(" & mV1 & ")"
    Else
        mV2 = sSheet.Range("B" & x + 3).Value
        Range("E" & lRow + 1).Value = mV2
    End If
    Range("E" & lRow + 2).Value = mV2 - mV1
    x = x + 8
    lRow = lRow + 3
Loop Until sSheet.Range("A" & x).Value = vbNullString

End Sub


Best regards,
Trowa
1