0

I'm using this code, but columns with last row (A,B,K,L) fill in with 0 beyond the defined last row. Additionally, my transaction and type occasionally stop working, but if anyone sees what i'm doing wrong i'd love to learn so i don't have this issue again.

 Sub test()
Dim lastRow As Long
    

    lastRow = Cells(Rows.Count, 10).End(xlUp).Row

    'delete blank columns
    Range("W:W,U:U,S:S,Q:Q,O:O,M:M,K:K,I:I,G:G,E:E,C:C,A:A").Select
    Range("A1").Activate
    Selection.Delete Shift:=xlToLeft

      'filter for blanks
    Range("A:L").CurrentRegion.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$L$1").AutoFilter Field:=10, Criteria1:="="
    ActiveSheet.AutoFilter.Range.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)
      Selection.AutoFilter
 'Trans
    Columns("A:A").Select
       Selection.NumberFormat = "General"
       Range("A2:A" & lastRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
       Columns("A:A").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
  'Type 
 Columns("B:B").Select
       Selection.NumberFormat = "General"
     Range("B2:B" & lastRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        Columns("B:B").Select
       Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False 
   'Debit
   Range("K2:K" & lastRow).Select
     'Range(Selection, Selection.End(xlDown)).Select
        Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
           ReplaceFormat:=False
    'credit
       Range("L2:L" & lastRow).Select
        'Range(Selection, Selection.End(xlDown)).Select
        Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
               
End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
JAM
  • 13
  • 1
  • 2
  • You determine the `lastRow` in column J (columns(10)). `Range("K2:K" & lastRow)` will include all cells in column K from K2 to the last used row of column J. BTW, if you were to remove all *Activate* and *Select* commands and replace the `Selection` object with `Range` objects (instead of working with both most of the time) your code would shrink to about half its present size and run 10 times faster. – Variatus Jul 10 '20 at 00:34
  • You need to bring the line `lastRow = Cells(Rows.Count, 10).End(xlUp).Row` after you delete blanks (i.e. just before `'Trans` – Super Symmetry Jul 10 '20 at 00:50
  • What do you mean by "my transaction and type occasionally stop working"? What exactly stops working? – Super Symmetry Jul 10 '20 at 00:53

1 Answers1

-1

So sorry for my English, just get you wrong

Try to use cycle instead of replace. Use Dim EmptCell as range once.

Dim EmptCell as range
For Each EmptCell in Range("youRange").Cells
If EmptCell.value = "" Then EmptCell.value = 0
Next EmptCell

And try to not to use selection. Work directly with a ranges, or use variables like you did with LastRow.

Small example below.

 '  Trans 
Columns("A:A").NumberFormat = "General" 
Range("A2:A" & lastRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
 Columns("A:A").value = Columns("A:A").value   

And I'm definitely recommend to change LastRow algorithm to this bulletproof one. © https://stackoverflow.com/a/11169920/12882709

With Sheets("Sheet1")
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lastrow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        lastrow = 1
    End If