Results 1 to 9 of 9

Thread: [RESOLVED] If column C has blank cell then delete that entire row in two files(macro correction)

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Jul 2020
    Posts
    24

    Resolved [RESOLVED] If column C has blank cell then delete that entire row in two files(macro correction)

    Hi Experts,

    Code:
    Sub STEP11CORRECTIONPENDING()
    Dim arrWbs() As Variant
     Let arrWbs() = Array("C:\Users\WolfieeeStyle\Desktop\Files\BasketOrder.xlsx", "C:\Users\WolfieeeStyle\Desktop\Files\Error.xlsx")
    
    Dim Wb As Workbook, Ws As Worksheet
    
    Dim Stear As Variant
        For Each Stear In arrWbs()
    
         Set Wb = Workbooks.Open(Stear)
                                                                                                                      
         Set Ws = Wb.Worksheets.Item(1)
        Dim LrC As Long: Let LrC = Ws.Range("C" & Ws.Rows.Count & "").End(xlUp).Row
        Dim Lc As Long: Let Lc = Ws.UsedRange.Columns.Count - Ws.UsedRange.Column + 1
        Dim arrC() As Variant: Let arrC() = Ws.Range("C1:C" & LrC & "").Value2
        
        Dim Cnt As Long
            For Cnt = 1 To LrC
            Dim strRws As String
                If arrC(Cnt, 1) <> "" Then Let strRws = strRws & Cnt & " "
            Next Cnt
        Let strRws = Left(strRws, Len(strRws) - 1)
        
        Dim Rws() As String: Let Rws() = Split(strRws, " ", -1, vbBinaryCompare)
        Dim RwsT() As Variant: ReDim RwsT(1 To UBound(Rws) + 1, 1 To 1)
            For Cnt = 1 To UBound(Rws) + 1
             Let RwsT(Cnt, 1) = Rws(Cnt - 1)
            Next Cnt
        
        Dim Clms() As Variant
    '
         Let Clms() = Evaluate("=Column(A:" & CL(Lc) & ")")
        Dim arrOut() As Variant
         Let arrOut() = Application.Index(Ws.Cells, RwsT(), Clms())
        
         Ws.Cells.ClearContents
         Let Ws.Range("A1").Resize(UBound(arrOut(), 1), 21).Value2 = arrOut()
        
         Let strRws = ""
         Wb.Save
         Wb.Close
        Next Stear
    End Sub
        
     
     
    Public Function CL(ByVal lclm As Long) As String
        Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
    End Function

    This macro works perfect
    but if the sheet is blank Or sheet doesn't have data then it creates error & i dont want that to happen
    If sheet is blank then dont do anything
    plz help me in solving the same

  2. #2
    PowerPoster jdc2000's Avatar
    Join Date
    Oct 2001
    Location
    Idaho Falls, Idaho USA
    Posts
    2,392

    Re: If column C has blank cell then delete that entire row in two files(macro correct


  3. #3

    Thread Starter
    Junior Member
    Join Date
    Jul 2020
    Posts
    24

    Re: If column C has blank cell then delete that entire row in two files(macro correct

    Code:
    Sub STEP11CORRECTIONPENDING()
    Dim arrWbs() As Variant
     Let arrWbs() = Array("C:\Users\WolfieeeStyle\Desktop\Files\BasketOrder.xlsx", "C:\Users\WolfieeeStyle\Desktop\Files\Error.xlsx")
    
    Dim Wb As Workbook, Ws As Worksheet
    
    Dim Stear As Variant
        For Each Stear In arrWbs()
    
         Set Wb = Workbooks.Open(Stear)
                                                                                                                      
         Set Ws = Wb.Worksheets.Item(1)
        Dim LrC As Long: Let LrC = Ws.Range("C" & Ws.Rows.Count & "").End(xlUp).Row
        Dim Lc As Long: Let Lc = Ws.UsedRange.Columns.Count - Ws.UsedRange.Column + 1
        Dim arrC() As Variant: Let arrC() = Ws.Range("C1:C" & LrC & "").Value2
        
        Dim Cnt As Long
        If ActiveSheet.Cells(1, 1) = ""
            For Cnt = 1 To LrC
            Dim strRws As String
                If arrC(Cnt, 1) <> "" Then Let strRws = strRws & Cnt & " "
            Next Cnt
        Let strRws = Left(strRws, Len(strRws) - 1)
        
        Dim Rws() As String: Let Rws() = Split(strRws, " ", -1, vbBinaryCompare)
        Dim RwsT() As Variant: ReDim RwsT(1 To UBound(Rws) + 1, 1 To 1)
            For Cnt = 1 To UBound(Rws) + 1
             Let RwsT(Cnt, 1) = Rws(Cnt - 1)
            Next Cnt
        
        Dim Clms() As Variant
    '
         Let Clms() = Evaluate("=Column(A:" & CL(Lc) & ")")
        Dim arrOut() As Variant
         Let arrOut() = Application.Index(Ws.Cells, RwsT(), Clms())
        
         Ws.Cells.ClearContents
         Let Ws.Range("A1").Resize(UBound(arrOut(), 1), 21).Value2 = arrOut()
        
         Let strRws = ""
         Wb.Save
         Wb.Close
        Next Stear
    End Sub
        
     
     
    Public Function CL(ByVal lclm As Long) As String
        Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
    End Function
    Getting Error:
    Run-time error '13':
    Type mismatch

    Highlighted line:
    Code:
    Dim arrC() As Variant: Let arrC() = Ws.Range("C1:C" & LrC & "").Value2
    & For this problem also If a complete sheet is blank then exit Sir
    Last edited by mail2tradesmart; Jul 24th, 2020 at 11:51 AM.

  4. #4
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: If column C has blank cell then delete that entire row in two files(macro correct

    you can test for empty sheet
    Code:
    if not isempty(ActiveSheet.UsedRange) then
    to test if a range is blank (empty)
    Code:
    If WorksheetFunction.CountBlank (columns("c")) = columns("c").cells.count then 'no data
    change range to suit
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  5. #5

    Thread Starter
    Junior Member
    Join Date
    Jul 2020
    Posts
    24

    Re: If column C has blank cell then delete that entire row in two files(macro correct

    If in any of the file if sheet1 is blank then close that file
    sheet name can be anything
    this will be the perfect solution for this problem & this modification i need
    Thnx Westconn1 Sir for providing the line i modofied that & it is working but i need this modification in the macro
    So plz have a relook Sir

  6. #6
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: If column C has blank cell then delete that entire row in two files(macro correct

    just add refference to the worksheet object
    Code:
         Set wb = Workbooks.Open(Stear)
         Set ws = wb.Worksheets(1)
         '  test this first
         If IsEmpty(ws.UsedRange) Or WorksheetFunction.CountBlank(ws.Columns("c")) = ws.Columns("c").Cells.Count Then wb.Close False: Exit Sub        'do not save changes
          '    then do your other stuff
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  7. #7

    Thread Starter
    Junior Member
    Join Date
    Jul 2020
    Posts
    24

    Re: If column C has blank cell then delete that entire row in two files(macro correct

    If there is any blank cell in column C then it will delete that entire row
    this macro checks both the file one by one & if condition met it should delete that entire row & if condition not met then close that file
    (it may happen that 1 file met the condition & one file doesn't met then it that scenario the file which met with the condition it should process for that & the one who doesn't met the condition don't do anything with that simply close that file)





    https://drive.google.com/file/d/1-sS...ew?usp=sharing
    https://drive.google.com/file/d/1-RK...ew?usp=sharing

  8. #8
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: If column C has blank cell then delete that entire row in two files(macro correct

    If there is any blank cell in column C then it will delete that entire row
    that was not specified anywhere i saw in the thread, i only answered the question in this thread about empty sheet or no data, i presumed the existing code (do your other stuff) must do whatever else was required

    you could do a countblank on the rows of column c, if > 0 then iterate the rows
    if you delete row while iterating you will miss checking some rows, unless you iterate from the bottom up
    or, add all the rows to be deleted to a non-contigous range then delete that range after iterating all rows, see a similar code in one of your other threads

    if you want to post files you should attach to posts here (zip first), rather than third party hosting
    if you want to attach images of worksheets you should make sure the resolution is readable by others, mostly i can not see the detail in them
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  9. #9

    Thread Starter
    Junior Member
    Join Date
    Jul 2020
    Posts
    24

    Re: [RESOLVED] If column C has blank cell then delete that entire row in two files(ma

    Problem Solved

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width