VBA to replace formulas

t0azt

Board Regular
Joined
Aug 1, 2012
Messages
134
I have a template for journal entries that I need to get into a different format. Right now I'm writing formulas that are working, but I cannot drag down so I'm thinking there might be a vba solution.

There are 6 columns, B:G, account, center, debit, credit, company, plant.

account and center must be 10 characters long (accounts are 5 characters but I add spaces to make up the difference), debit and credit are 17 characters long, and comany and plant are 3 characters each.

If there is an amount in the credit column I need it to be changed to the number and - at the end (384- for example.)

If debit AND credit are both blank or 0 I want them to be excluded.

If possible, I would like a blank line between every 4 entries.

So what I'm trying to do is extract the account with the spaces in one cell (so if the account is 10100 the cell would contain "10100 " without the quotes), lets say column I, the center in column J, and debit or credit in K, with the company and plant concatenated under the center with leading zeros.

Something like this:
BCDEFGHIJK
acctcenterdrcrcoplant
21100074200.60111100074200.6
3101005310219142.82012001001
462252512043413.6217101005310219142.82
5001002
62258223502677.1901862252512043413.62-
71100072614.230115001007
85310251201001472258223502677.19
9221001432.20150001008
10221701300.8812
11221651611.311511100072614.23
12001015
13221001432.20-
14001050
15221701300.88
16001002
17221651611.31-
18001051

<tbody>
</tbody>


And so on... right now I have the following formulas
I2=B2&REPT(" ",10-LEN(B2))
J2=C2&REPT(" ",10-LEN(C2))
K2=IF(D2>0,D2&REPT(" ",17-LEN(D2)),E2&"-"&REPT(" ",16-LEN(E2)))
J3=REPT("0",3-LEN(F2))&F2&REPT("0",3-LEN(G2))&G2

<tbody>
</tbody>







Any help would be appreciated!

Thanks!
 
Last edited:

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,734
Code:
Option Explicit


Sub ModifyTable()
    Dim vIn As Variant, vOut As Variant
    Dim lRi As Long, lRo As Long, lC As Long, UB1 As Long, UB2 As Long
    
    vIn = Range("B1").CurrentRegion.Value   '<<<<< assuming range starts in B1
    UB1 = UBound(vIn, 1)
    UB2 = UBound(vIn, 2)
    ' Make the output array large enough for the doubling of rows and the extra row every 4 input rows
    ReDim vOut(1 To UB1 * 2 + Int(UB1 / 4 + 0.5), 1 To 3)
    
    'process columns
    For lRi = 2 To UB1  'skip heading row
        'set output row
        lRo = lRo + 2
        If lRi Mod 4 = 1 Then lRo = lRo + 1 'every four rows taking account of header row
        
        For lC = 1 To UB2
            Select Case lC
                Case 1, 2   'columns B & C - fill out to length 10 with spaces
                    vOut(lRo, lC) = SpaceUp(CStr(vIn(lRi, lC)), 10)
                Case 3   'columns D - fill out to length 17 with spaces
                    If CLng(vIn(lRi, lC)) > 0 Then vOut(lRo, lC) = SpaceUp(CStr(vIn(lRi, lC)), 17)
                Case 4      'column E
                    If CLng(vIn(lRi, lC)) > 0 Then vOut(lRo, 3) = SpaceUp(CStr(vIn(lRi, lC)) & "-", 17)
                Case 5      'column F, proces column G at same time
                    vOut(lRo + 1, 2) = ZeroUp(CStr(vIn(lRi, lC)), 3) & ZeroUp(CStr(vIn(lRi, lC + 1)), 3)
            End Select
        Next lC
    Next lRi
    
    'Now output trhe output array
    '<<<<< you can do this to different sheet if wanted
    With ActiveSheet.Range("I1").Resize(UBound(vOut, 1), UBound(vOut, 2))
        .Value = vOut
    End With
End Sub

Function SpaceUp(sIn As String, iLen As Integer) As String
'Return string appended with space characters
'to specified length
    Dim lSL As Long
    
    lSL = Len(sIn)
    If lSL > iLen Then  'error check if specified length is too small
        SpaceUp = sIn
    Else
        SpaceUp = sIn & Space$(iLen - Len(sIn))
    End If
End Function

Function ZeroUp(sIn As String, iLen As Integer) As String
'Return string starting with 0 characters
'to specified length
    Dim lSL As Long
    
    lSL = Len(sIn)
    If lSL > iLen Then  'error check if specified length is too small
        ZeroUp = sIn
    Else
        ZeroUp = String$(iLen - Len(sIn), "0") & sIn
    End If
End Function
Read the comments and act on the ones with <<<<<
 
Last edited:

Amelia742

New Member
Joined
Aug 3, 2019
Messages
4
Hi,
Create VBA macro to replace formula's in cells of all sheets in workbook
For instance:

code:
Sub finandreplace()
For Each ws In ThisWorkbook.Worksheets
For i = 4 To 5
ws.Cells.Replace "=A" & i, "=" & Cells(1, i - 2).Address(0, 0), xlWhole
Next
Next
End Sub
 

Amelia742

New Member
Joined
Aug 3, 2019
Messages
4
Hi,
Create VBA macro to replace formula's in cells of all sheets in workbook
For instance:

code:
Sub finandreplace()
For Each ws In ThisWorkbook.Worksheets
For i = 4 To 5
ws.Cells.Replace "=A" & i, "=" & Cells(1, i - 2).Address(0, 0), xlWhole
Next
Next
End Sub
did it work?


<style type="text/css"><!--td {border: 1px solid #ccc;}br {mso-data-placement:same-cell;}--></style>Dafont Showbox Adam4adam
 

Watch MrExcel Video

Forum statistics

Threads
1,127,318
Messages
5,623,976
Members
416,003
Latest member
indyman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top