-
Jul 24th, 2020, 08:47 AM
#1
Thread Starter
Junior Member
[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
-
Jul 24th, 2020, 11:19 AM
#2
Re: If column C has blank cell then delete that entire row in two files(macro correct
-
Jul 24th, 2020, 11:28 AM
#3
Thread Starter
Junior Member
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.
-
Jul 24th, 2020, 04:40 PM
#4
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
-
Jul 25th, 2020, 12:58 AM
#5
Thread Starter
Junior Member
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
-
Jul 25th, 2020, 05:19 AM
#6
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
-
Jul 25th, 2020, 06:00 AM
#7
Thread Starter
Junior Member
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
-
Jul 26th, 2020, 05:29 AM
#8
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
-
Jul 29th, 2020, 07:14 AM
#9
Thread Starter
Junior Member
Re: [RESOLVED] If column C has blank cell then delete that entire row in two files(ma
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|