Code loop working partly only

RAJESH1960

Banned for repeated rules violations
Joined
Mar 26, 2020
Messages
2,313
Office Version
  1. 2019
Platform
  1. Windows
Hello guys

When I run the Step1 code in the sheet Original, the result is displayed in sheet Bank. The problem is, the numbers given by the code in column D misses giving numbers to many rows in the middle. Please, if someone can help me to correct this code, I would really appreciate it. I have attached the link of the file for reference.

 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Why this part:

VBA Code:
NewName = Sheets("Original").Range("K1")
VchNo = 1000
'Step thro Voucher column D2:D'Lastrow'as determined by last entry in E
For Each Cell In Range("D2:D" & Range("E" & Rows.Count).End(xlUp).Row)
    If Not Cell = vbNullString Then  'if not an empty cell then is a voucher number so update it
        VchNo = VchNo + 1
        Cell.Value = VchNo
     End If
 'Particular column is E which is 1 column offset right from D
 'Check and update if required
    If Cell.Offset(0, 1) = "(as per details)" Then Cell.Offset(0, 1).Value = NewName
      
Next Cell
End With

Do you want to count the invoices and overwrite the old invoice numbers?
 
Upvote 0
This is my best guess, replace moldule 1 with this:


VBA Code:
Option Explicit

Sub Step1()
Dim Original_ws As Worksheet
Dim Bank_ws As Worksheet
Set Original_ws = Worksheets("Original")
Set Bank_ws = Worksheets("Bank")

Bank_ws.Cells.Clear
Original_ws.Columns("A:I").Copy Bank_ws.Range("a1")

Dim a As Variant, b As Variant, c As Variant
Dim Fnd As Range
Dim i As Long, j As Long, k As Long, ini As Long

With Bank_ws
    .UsedRange.UnMerge 'Unmerge cells in banksheet
    Set Fnd = .Range("A:A").Find("Date", , , xlPart, xlByRows, xlNext, False, , False)
    If Not Fnd Is Nothing And Fnd.Row > 1 Then ini = Fnd.Row + 2 Else ini = 1
    a = .Range("A" & ini, .Range("I" & Rows.Count).End(3)).Value
End With
  
ReDim b(1 To UBound(a), 1 To 8)

For i = 1 To UBound(a) - 3
    If Len(a(i, 7)) <> 0 Then
        j = j + 1
        b(j, 1) = i 'Line
        b(j, 2) = a(i, 1) 'Date
        b(j, 3) = a(i, 6) 'Vch Type
        b(j, 4) = a(i, 7) 'Vch No.
        b(j, 5) = a(i, 3) 'Particulars
        b(j, 6) = a(i, 8) 'Debit
        b(j, 7) = a(i, 9) 'Credit
    ElseIf Len(b(j, 4)) <> 0 And Len(a(i, 1)) = 0 And b(j, 4) <> "None" Then
        j = j + 1
        Debug.Print a(i - 1, 7)
        a(i, 1) = a(i - 1, 1) 'Date
        a(i, 6) = a(i - 1, 6) 'Vch Type
        a(i, 7) = a(i - 1, 7) 'Vch No.
        
        b(j, 1) = i 'Line
        b(j, 2) = a(i, 1) 'Date
        b(j, 3) = a(i, 6) 'Vch Type
        b(j, 4) = a(i, 7) 'Vch No.
        b(j, 5) = a(i, 3) 'Particulars
        b(j, 6) = a(i, 8) 'Debit
        b(j, 7) = a(i, 9) 'Credit
    Else
        j = j + 1
        b(j, 1) = i 'Line
        b(j, 2) = a(i, 1) 'Date
        b(j, 3) = a(i, 6) 'Vch Type
        b(j, 4) = "None" 'Vch No.
        b(j, 5) = a(i, 3) 'Particulars
        b(j, 6) = a(i, 8) 'Debit
        b(j, 7) = a(i, 9) 'Credit
    End If
Next i
  
With Bank_ws
    .Cells.Clear
    .Range("A1:G1").Value = Array("Line", "Date", "Vch Type", "Vch No.", "Particulars", "Debit", "Credit")
    .Range("A2").Resize(j, 7).Value = b
    .Columns("F:G").NumberFormat = "0.00"
    
    With .Cells
        .EntireColumn.AutoFit
        .Borders.LineStyle = xlNone
        .HorizontalAlignment = xlLeft
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    
        With .Font
            .Bold = False
            .Name = "Calibri"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
        End With 'font
    End With  'cells
    .Range("A:A").NumberFormat = "General"
    .Range("B:B").NumberFormat = "dd-mm-yyyy"
End With

With Bank_ws.Cells.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

End Sub
 
Upvote 0
This is my best guess, replace moldule 1 with this:


VBA Code:
Option Explicit

Sub Step1()
Dim Original_ws As Worksheet
Dim Bank_ws As Worksheet
Set Original_ws = Worksheets("Original")
Set Bank_ws = Worksheets("Bank")

Bank_ws.Cells.Clear
Original_ws.Columns("A:I").Copy Bank_ws.Range("a1")

Dim a As Variant, b As Variant, c As Variant
Dim Fnd As Range
Dim i As Long, j As Long, k As Long, ini As Long

With Bank_ws
    .UsedRange.UnMerge 'Unmerge cells in banksheet
    Set Fnd = .Range("A:A").Find("Date", , , xlPart, xlByRows, xlNext, False, , False)
    If Not Fnd Is Nothing And Fnd.Row > 1 Then ini = Fnd.Row + 2 Else ini = 1
    a = .Range("A" & ini, .Range("I" & Rows.Count).End(3)).Value
End With
 
ReDim b(1 To UBound(a), 1 To 8)

For i = 1 To UBound(a) - 3
    If Len(a(i, 7)) <> 0 Then
        j = j + 1
        b(j, 1) = i 'Line
        b(j, 2) = a(i, 1) 'Date
        b(j, 3) = a(i, 6) 'Vch Type
        b(j, 4) = a(i, 7) 'Vch No.
        b(j, 5) = a(i, 3) 'Particulars
        b(j, 6) = a(i, 8) 'Debit
        b(j, 7) = a(i, 9) 'Credit
    ElseIf Len(b(j, 4)) <> 0 And Len(a(i, 1)) = 0 And b(j, 4) <> "None" Then
        j = j + 1
        Debug.Print a(i - 1, 7)
        a(i, 1) = a(i - 1, 1) 'Date
        a(i, 6) = a(i - 1, 6) 'Vch Type
        a(i, 7) = a(i - 1, 7) 'Vch No.
       
        b(j, 1) = i 'Line
        b(j, 2) = a(i, 1) 'Date
        b(j, 3) = a(i, 6) 'Vch Type
        b(j, 4) = a(i, 7) 'Vch No.
        b(j, 5) = a(i, 3) 'Particulars
        b(j, 6) = a(i, 8) 'Debit
        b(j, 7) = a(i, 9) 'Credit
    Else
        j = j + 1
        b(j, 1) = i 'Line
        b(j, 2) = a(i, 1) 'Date
        b(j, 3) = a(i, 6) 'Vch Type
        b(j, 4) = "None" 'Vch No.
        b(j, 5) = a(i, 3) 'Particulars
        b(j, 6) = a(i, 8) 'Debit
        b(j, 7) = a(i, 9) 'Credit
    End If
Next i
 
With Bank_ws
    .Cells.Clear
    .Range("A1:G1").Value = Array("Line", "Date", "Vch Type", "Vch No.", "Particulars", "Debit", "Credit")
    .Range("A2").Resize(j, 7).Value = b
    .Columns("F:G").NumberFormat = "0.00"
   
    With .Cells
        .EntireColumn.AutoFit
        .Borders.LineStyle = xlNone
        .HorizontalAlignment = xlLeft
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
   
        With .Font
            .Bold = False
            .Name = "Calibri"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
        End With 'font
    End With  'cells
    .Range("A:A").NumberFormat = "General"
    .Range("B:B").NumberFormat = "dd-mm-yyyy"
End With

With Bank_ws.Cells.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

End Sub
Hello VincentNL99. You understood right. I am giving new numbers to each row which has a date. Since there are no numbers in some of the entries I am giving them numbers in a series. The original is the format sent by the client but to import it into our server I need to change the format that suits our server. The problem is I am not able to get numbers to all the entries correctly. So many entries are left out.
 
Upvote 0
I am separating the single and combined entries into sheet Bank. I have inserted a line between the single and multiple entries. The cells containing None should be replaced with numbers - a continuation of the series of numbers.
In my original post I have marked the cell with yellow color to show where the numbers are missing.
 
Upvote 0
I am separating the single and combined entries into sheet Bank. I have inserted a line between the single and multiple entries. The cells containing None should be replaced with numbers - a continuation of the series of numbers.
In my original post I have marked the cell with yellow color to show where the numbers are missing.
I understand right you don't care about the original invoice numbers?
 
Upvote 0
I found the reason for the error. In the original sheet the Vch. No. of some entries is missing. If I fill the cells with any random number it will work as I expect. I can't understand how and where to edit the code to fill those cells.
 
Upvote 0
I found the reason for the error. In the original sheet the Vch. No. of some entries is missing. If I fill the cells with any random number it will work as I expect. I can't understand how and where to edit the code to fill those cells. Easier way is to replace all numbers in Vch.No. column. The condition is that if the cells in range F9 :F is blank then show blank else show a number any number. I need help to insert this condition in the code.
Please check the attached file. Please note that this is a merged fill and should stay merged to run the code right.
I found the reason for the error. In the original sheet the Vch. No. of some entries is missing. If I fill the cells with any random number it will work as I expect. I can't understand how and where to edit the code to fill those cells.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,264
Members
448,558
Latest member
aivin

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