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

zyxw1234
Banned
Posts: 253
Joined: 22 Apr 2020, 17:24

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

Post by zyxw1234 »

Hi Experts,

Code: Select all

Sub STEP11CORRECTIONPENDING()
Dim arrWbs() As Variant
 Let arrWbs() = Array("C:UsersWolfieeeStyleDesktopFilesBasketOrder.xlsx", "C:UsersWolfieeeStyleDesktopFilesError.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
https://excelfox.com/forum/showthread.p ... iles/page7

User avatar
HansV
Administrator
Posts: 78234
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

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

Post by HansV »

If the worksheet is empty, then LrC will be 1. So you could check for that:

Code: Select all

Sub STEP11CORRECTIONPENDING()
    Dim arrWbs() As Variant
    Let arrWbs() = Array("C:Users\**I've been banned**\Desktop\Files\BasketOrder.xlsx", "C:Users\**I've been banned**\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
        ' Do we have data?
        If LrC > 1 Then
            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
        End If
        Wb.Close
    Next Stear
End Sub
Best wishes,
Hans

User avatar
Leif
Administrator
Posts: 7192
Joined: 15 Jan 2010, 22:52
Location: Middle of England

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

Post by Leif »

zyxw1234 wrote:
24 Jul 2020, 09:12
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
Alternatively, why don't you just trap the error and exit if it occurs?

(Tip: How to search on Google - Google Search Help and search on "excel on error")
Leif

zyxw1234
Banned
Posts: 253
Joined: 22 Apr 2020, 17:24

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

Post by zyxw1234 »

Thnx HansV Sir But error is there

Compile Error
Sub or Function not defined
something is not proper in this line
Let Clms() = Evaluate("=Column(A:" & CL(Lc) & ")")

User avatar
HansV
Administrator
Posts: 78234
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

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

Post by HansV »

I'm sorry, I don't know enough about the code to help with that (it looks like it was written by Doc.AElstein)
Best wishes,
Hans

zyxw1234
Banned
Posts: 253
Joined: 22 Apr 2020, 17:24

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

Post by zyxw1234 »

Ok No problem Sir
Thnx Alot for helping me in solving ths problem Sir
Have a Awesome Day