VBA to replace formulas

T

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:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]acct[/TD]
[TD]center[/TD]
[TD]dr[/TD]
[TD]cr[/TD]
[TD]co[/TD]
[TD]plant[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]11000[/TD]
[TD]7[/TD]
[TD]4200.6[/TD]
[TD]0[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD][/TD]
[TD]11000[/TD]
[TD]7[/TD]
[TD]4200.6[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]10100[/TD]
[TD]53102[/TD]
[TD]19142.82[/TD]
[TD]0[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD][/TD]
[TD][/TD]
[TD]001001[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]62252[/TD]
[TD]51204[/TD]
[TD][/TD]
[TD]3413.62[/TD]
[TD]1[/TD]
[TD]7[/TD]
[TD][/TD]
[TD]10100[/TD]
[TD]53102[/TD]
[TD]19142.82[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]001002[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]22582[/TD]
[TD]23502[/TD]
[TD]677.19[/TD]
[TD]0[/TD]
[TD]1[/TD]
[TD]8[/TD]
[TD][/TD]
[TD]62252[/TD]
[TD]51204[/TD]
[TD]3413.62-[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]11000[/TD]
[TD]7[/TD]
[TD]2614.23[/TD]
[TD]0[/TD]
[TD]1[/TD]
[TD]15[/TD]
[TD][/TD]
[TD][/TD]
[TD]001007[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]53102[/TD]
[TD]51201[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]1[/TD]
[TD]47[/TD]
[TD][/TD]
[TD]22582[/TD]
[TD]23502[/TD]
[TD]677.19[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]22100[/TD]
[TD]1[/TD]
[TD][/TD]
[TD]432.20[/TD]
[TD]1[/TD]
[TD]50[/TD]
[TD][/TD]
[TD][/TD]
[TD]001008[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]22170[/TD]
[TD]1[/TD]
[TD]300.88[/TD]
[TD][/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]22165[/TD]
[TD]1[/TD]
[TD][/TD]
[TD]611.31[/TD]
[TD]1[/TD]
[TD]51[/TD]
[TD][/TD]
[TD]11000[/TD]
[TD]7[/TD]
[TD]2614.23[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]001015[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]22100[/TD]
[TD]1[/TD]
[TD]432.20-[/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]001050[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]22170[/TD]
[TD]1[/TD]
[TD]300.88[/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]001002[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]22165[/TD]
[TD]1[/TD]
[TD]611.31-[/TD]
[/TR]
[TR]
[TD]18[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]001051[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


And so on... right now I have the following formulas
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]I2[/TD]
[TD]=B2&REPT(" ",10-LEN(B2))[/TD]
[/TR]
[TR]
[TD]J2[/TD]
[TD]=C2&REPT(" ",10-LEN(C2))[/TD]
[/TR]
[TR]
[TD]K2[/TD]
[TD]=IF(D2>0,D2&REPT(" ",17-LEN(D2)),E2&"-"&REPT(" ",16-LEN(E2)))[/TD]
[/TR]
[TR]
[TD]J3[/TD]
[TD]=REPT("0",3-LEN(F2))&F2&REPT("0",3-LEN(G2))&G2[/TD]
[/TR]
</tbody>[/TABLE]







Any help would be appreciated!

Thanks!
 
Last edited:

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Sort by date Sort by votes
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:
Upvote 0
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
 
Upvote 0
Amelia742 said:
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
Click to expand...
did it work?


<style type="text/css"><!--td {border: 1px solid #ccc;}br {mso-data-placement:same-cell;}--></style>Dafont Showbox Adam4adam
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

Share this page

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
Back
Top