Delete a row if cell is empty, enter formulas in cells if there is data in other column cell, and several other questions

WaqasTariq

Board Regular
Joined
Jun 26, 2012
Messages
54
Office Version
  1. 365
Hi,
Five days ago it was since 10 years that I last used VB, and needless to say I am pretty rotten, have tried searching for most of the answers but still have a host of them left, so decided to post a topic.

The Scenario (Worksheet: Interface File):
Column C to G contain data (these are un-protected columns for entering data)
Column I to N contain data (these are protected columns for displaying and copying data)
The sheet is protected (without a password)


What I want to achieve (other than what has been done):
  1. Delete row if there is no data (or a 0) in cell (of column C), except the first row (as it contains headings)
  2. If there is data in column C (adjacent cell), the enter the formula's "=WEEKNUM(C22,2)", "=CHOOSE(WEEKDAY(C21),"Sun","Mon","Tue","Wed","Thu","Fri","Sat")", and "=MOD(C22,1)"in column J, K, and L respectively, except the first row (as it contains headings).
  3. In the other worksheet "TestData" (which is opened using macro), delete row if there is no data (or a 0) in cell (of column E, this cell can also contain words, right now has numbers), except the first row (as it contains headings).
  4. In the other worksheet "TestData" if there is data (words or numbers) in column E (adjacent cell) then add following text: "3", "Item" and "Process" in column A, B and C (cells) respectively.

I will be forever in debt if anyone can help me with this.

Following is what I have done so far (files also attached):

Interface File
TestDate

Code:
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
    
    Dim Lastrow As Integer
    With ActiveSheet
        Lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row
    End With




    Intersect(ActiveSheet.UsedRange.Columns("E:F").SpecialCells(2).EntireRow, Columns("I")).FormulaR1C1 = "=RC5+RC6+RC7"
    Intersect(ActiveSheet.UsedRange.Columns("E:F").SpecialCells(2).EntireRow, Columns("M")).FormulaR1C1 = "=RC4"
    
    Set Rng = Range("I2" & ":I" & Lastrow)
    Rng.Copy
    Workbooks.Open Filename:=ThisWorkbook.Path & "\TestData"
    Sheets("Scheduled Arrival").Select
    Range("E2" & ":E" & Lastrow).PasteSpecial xlPasteValues
    Workbooks("Interface File").Activate
    
    Set Rng = Range("J2" & ":J" & Lastrow)
    Rng.Copy
    Workbooks("TestData").Activate
    Sheets("Scheduled Arrival").Select
    Range("F2" & ":F" & Lastrow).PasteSpecial xlPasteValues
    Workbooks("Interface File").Activate
    
    
    Set Rng = Range("K2" & ":K" & Lastrow)
    Rng.Copy
    Workbooks("TestData").Activate
    Sheets("Scheduled Arrival").Select
    Range("G2" & ":G" & Lastrow).PasteSpecial xlPasteValues
    Workbooks("Interface File").Activate
    
    Set Rng = Range("L2" & ":L" & Lastrow)
    Rng.Copy
    Workbooks("TestData").Activate
    Sheets("Scheduled Arrival").Select
    Range("H2" & ":H" & Lastrow).PasteSpecial xlPasteValues
    Workbooks("Interface File").Activate
    
    Set Rng = Range("M2" & ":M" & Lastrow)
    Rng.Copy
    Workbooks("TestData").Activate
    Sheets("Scheduled Arrival").Select
    Range("I2" & ":I" & Lastrow).PasteSpecial xlPasteValues
    Cells(1, 1).Activate
    Workbooks("Interface File").Activate
    
    Workbooks("TestData").Save
    Workbooks("TestData").Close
    Workbooks("Interface File").Save
    ActiveSheet.Protect
    Application.ScreenUpdating = True
 
Last edited:

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Okay, I have found this to delete the rows, it works perfectly when there are empty cells but errors out (error 1004, no cells were found) when there are none, any help?

Code:
Columns("E:E").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 
Upvote 0
Just to update that I have resolved all the questions.

Code:
Sub Button1_Click()    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
    
    Dim Lastrow As Integer
    With ActiveSheet
        Lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row
    End With
    
    On Error Resume Next
    Columns("D:D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    Intersect(ActiveSheet.UsedRange.Columns("E:F").SpecialCells(2).EntireRow, Columns("I2")).FormulaR1C1 = "=CONCATENATE(""v_Dir = D3("",RC5,"",1,"",RC6,"",2,"",RC7,"",3)"")"
    Intersect(ActiveSheet.UsedRange.Columns("E:F").SpecialCells(2).EntireRow, Columns("J2")).FormulaR1C1 = "=WEEKNUM(RC3,2)"
    Intersect(ActiveSheet.UsedRange.Columns("E:F").SpecialCells(2).EntireRow, Columns("K2")).FormulaR1C1 = "=CHOOSE(WEEKDAY(RC3),""Sun"",""Mon"",""Tue"",""Wed"",""Thu"",""Fri"",""Sat"")"
    Intersect(ActiveSheet.UsedRange.Columns("E:F").SpecialCells(2).EntireRow, Columns("L2")).FormulaR1C1 = "=MOD(RC3,1)"
    Intersect(ActiveSheet.UsedRange.Columns("E:F").SpecialCells(2).EntireRow, Columns("M2")).FormulaR1C1 = "=RC4"
    
    Set Rng = Range("I2" & ":I" & Lastrow)
    Rng.Copy
    Workbooks.Open Filename:=ThisWorkbook.Path & "\TestData"
    Sheets("Scheduled Arrival").Select
    Range("E2" & ":E" & Lastrow).PasteSpecial xlPasteValues
    Workbooks("Interface File").Activate
    
    Set Rng = Range("J2" & ":J" & Lastrow)
    Rng.Copy
    Workbooks("TestData").Activate
    Sheets("Scheduled Arrival").Select
    Range("F2" & ":F" & Lastrow).PasteSpecial xlPasteValues
    Workbooks("Interface File").Activate
    
    
    Set Rng = Range("K2" & ":K" & Lastrow)
    Rng.Copy
    Workbooks("TestData").Activate
    Sheets("Scheduled Arrival").Select
    Range("G2" & ":G" & Lastrow).PasteSpecial xlPasteValues
    Workbooks("Interface File").Activate
    
    Set Rng = Range("L2" & ":L" & Lastrow)
    Rng.Copy
    Workbooks("TestData").Activate
    Sheets("Scheduled Arrival").Select
    Range("H2" & ":H" & Lastrow).PasteSpecial xlPasteValues
    Workbooks("Interface File").Activate
    
    Set Rng = Range("M2" & ":M" & Lastrow)
    Rng.Copy
    Workbooks("TestData").Activate
    Sheets("Scheduled Arrival").Select
    Range("I2" & ":I" & Lastrow).PasteSpecial xlPasteValues
    
    Intersect(ActiveSheet.UsedRange.Columns("G:H").SpecialCells(2).EntireRow, Columns("A")).FormulaR1C1 = "3"
    Intersect(ActiveSheet.UsedRange.Columns("G:H").SpecialCells(2).EntireRow, Columns("B")).FormulaR1C1 = "Item"
    Intersect(ActiveSheet.UsedRange.Columns("G:H").SpecialCells(2).EntireRow, Columns("C")).FormulaR1C1 = "Process"
    
    On Error Resume Next
    Columns("G:H").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    Cells(1, 1).Activate
    Workbooks("Interface File").Activate
    
    Workbooks("TestData").Save
    Workbooks("TestData").Close
    Workbooks("Interface File").Save
    ActiveSheet.Protect
    Application.ScreenUpdating = True




End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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