I'm trying to sort out a manifest that needs to be converted to a different format.
Just wondering, is there a way for to find a group of blank cells and delete them, using VBA?
The files look like this:
name
address
address
region
-blank line-
-blank line-
-blank line-
Name
Address
Address
Region
-blank line etc
What I would like is something to delete out the grouped blank cells. The issue I have is sometimes one of the address columns is blank, (one blank line) so I can't just use Go to > Special...
What I would love is if I could work out how to have a VBA to run down the column, pick up a group of 3 or more blank cells on top of each other, and delete those entire rows.
Is that possible?
Cheers, Nigel.
You can always do something like this:
Sub DeleteBlanks()
Dim TotalRows As Long
Dim i As Long
Dim j As Long
TotalRows = Rows(Rows.Count).End(xlUp).Row
For i = TotalRows To 2 Step -1
'Check if there is more than one blank cell
If Cells(i, 1).Value = "" And Cells(i - 1, 1).Value = "" Then
'Count the number of cells that are blank
Do While Cells(i - j, 1).Value = ""
If i - j <= 1 Then
Exit Do
End If
j = j + 1
Loop
'Delete group of blank of cells
If i - j <= 1 Then
Rows(i & ":" & i - j).Delete
Else
Rows(i & ":" & i - j + 1).Delete
End If
j = 0
End If
Next
End Sub
Related
I have existing script that does a major chunk of what I need. The script (from here: https://www.extendoffice.com/documents/excel/4054-excel-duplicate-rows-based-on-cell-value.html) basically inserts and then copies rows of data X number of times, where X is one of the fields in the table. It works well and the referenced page shows examples of the start and end points.
But when I run the script in Excel I go from ~2,000 lines in my table to ~40,000 lines. I need to modify all the duplicated rows (incremental dates) and so I am now attemting to also include new data into the table while the script runs that will allow me to change data in the duplicated rows... for example I can use the duplicate number 1, 2, 3, 4 and some simple formulas to change dates relative to a start point.
I expect that I will need some additional code inserted into the routine that will add data into a nominated column and do the auto incrementing from 1.
Having zero actual VBA skillz, ive no idea how to tackle the second part of my problem with the code I already have. Any help would be totally awesome !!
Sub CopyData()
'Updateby Extendoffice 20160922
Dim xRow As Long
Dim VInSertNum As Variant
xRow = 1
Application.ScreenUpdating = False
Do While (Cells(xRow, "A") <> "")
VInSertNum = Cells(xRow, "D")
If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "D")).Select
Selection.Insert Shift:=xlDown
xRow = xRow + VInSertNum - 1
End If
xRow = xRow + 1
Loop
Application.ScreenUpdating = False
End Sub
Try this code below, I used the same sample data on the link you provided. However on this code I created 2 worksheets, one for the raw data to be processed and one for the duplicate output including the increment of dates and duplicate number.
Sub duplicateData()
Dim rSH As Worksheet
Set rSH = ThisWorkbook.Sheets("RAW") 'Your raw data
Dim oSH As Worksheet
Set oSH = ThisWorkbook.Sheets("OUTPUT") 'Output data on another sheet
x = 2
For a = 2 To rSH.Range("A" & Rows.Count).End(xlUp).Row
For b = 1 To rSH.Cells(a, 4).Value '4 is the column of duplicate times
If b = 1 Then
For c = 1 To 4 'Number of your column
oSH.Cells(x, c).Value = rSH.Cells(a, c).Value
Next c
oSH.Cells(x, 5) = 1 'First instance, 5 is the column number of duplicate counter
Else
For c = 1 To 4 'Number of your column
oSH.Cells(x, c).Value = rSH.Cells(a, c).Value
Next c
oSH.Cells(x, 3).Value = CDate(oSH.Cells(x - 1, 3).Value) + 1 '3 is the column number of date to increment
oSH.Cells(x, 5).Value = CInt(oSH.Cells(x - 1, 5).Value) + 1 '5 is the column number of duplicate counter
End If
x = x + 1 'Increment Output row number
Next b
Next a
End Sub
So my question is this I have this code here:
Private Sub Validate_Input_Click()
Dim temp As String
For Row = 2 To 250
temp = ""
For col = 2 To 12
If Cells(Row, col) <> "" Then
If temp <> "" Then temp = temp & "_"
temp = temp & Cells(Row, col)
End If
Next col
Cells(Row, 1) = temp
Next Row
End Sub
I have information from Column 2 all the way to 12 and works perfect. But now I'm trying to figure out if lets say, Rows 2-6 have all information from lines 2-6 inputted correctly all cells are filled in, Line 7 is missing a cell or two that isn't filled out and lines 8-12 inputted correctly, all cells are filled in, how do I make it so the macro Concatenates lines 2-6, skips 7 because of blank cells, and continues to concatenate 8-12?
Also, not all rows from 2 - 250 are filled out, usually goes to about 60 to 75 depending on what I'm doing with the worksheet at that time. Just want the extra buffer just in-case also why I'm trying to figure out a way to skip over blank cells and not concatenate that specific row or rows that have blank cells.
I've been messing around with If Else statements but can't quite get it.
Any help would be great!
We test for any blanks before processing the row:
Sub Validate_Input_Click()
Dim temp As String
For Row = 2 To 250
If Application.WorksheetFunction.CountBlank(Range(Cells(Row, 2), Cells(Row, 12))) = 0 Then
temp = ""
For col = 2 To 12
If Cells(Row, col) <> "" Then
If temp <> "" Then temp = temp & "_"
temp = temp & Cells(Row, col)
End If
Next col
Cells(Row, 1) = temp
End If
Next Row
End Sub
So I have a full sheet of item numbers that need to be updated for quantities on a daily basis. There are many items that contain two accessories as different item numbers such as what is shown below:
1114
1114-LA
15894/3
1114-LED
What I need to happen is for the value(quantity) of the two numbers with the -LA and -LED to equal the original item number's (ex. 1114) quantity. Some items have no other option and some only have one or the other, and some have both.
Any Ideas on how I could do this? The spreadsheet is several thousand numbers long.
here is what it looks like:
Item number Quantity
1114 5
1114-LA 0
1114-LED 0
225896/3 2
225896-LED 0
114895 8
114895-LED 91
114895-LA 0
115938/2 91
115938/2-LED 0
edited after OP's data pattern change
assuming, as per your example, that:
unknown accessories per item number
accessories follow immediately after item number
quantities are in column adjacent item numbers one
you can try this:
Sub main()
Dim iRow As Long
iRow = 1
Do While iRow < Cells(Rows.Count, 1).End(xlUp).Row '<--| change '1' to your actual columnn with item numbers index
If InStr(Cells(iRow, 1).Value, "-") = 0 Then
Do While InStr(Cells(iRow + 1, 1).Value, "-") > 0
Cells(iRow + 1, 2).Value = Cells(iRow, 2).Value
iRow = iRow + 1
Loop
Else
iRow = iRow + 1
End If
Loop
End Sub
while an alternative Autofilter() + "Formula" approach is the following:
Sub main2()
With Range("B1", Cells(Rows.Count, 1).End(xlUp)) '<--| assuming data are in range "A1:Bx" with row 1 headers
.AutoFilter field:=1, Criteria1:="*-*"
With .Resize(.Rows.Count - 1, 1).Offset(1, 1)
.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=R[-1]C"
.Parent.AutoFilterMode = False
.Value = .Value
End With
End With
End Sub
where row 1 must be a "header" row
Can you guys help me out? I think i'm kind of stuck with the code below. I almost got the code that I wanted but at the end it does not do the thing I like.
Dim acs, cos, as_col, as_row As Integer
cos = Sheets.Count
acs = ActiveSheet.Index
as_LRow = Sheets(acs).Cells(Sheets(acs).Rows.Count, "A").End(xlUp).Row
For as_row = 3 To as_LRow
std_number = Sheets(acs).Cells(as_row, 1).Value
earliersheets = acs - 1
For s = 1 To earliersheets
ilast_row = Sheets(s).Cells(Sheets(s).Rows.Count, "A").End(xlUp).Row
For r = 3 To ilast_row
std_number_new = Sheets(s).Cells(r, 1).Value
If std_number = std_number_new Then
a = a & Sheets(s).Cells(r, 6).Value
'Sheets(acs).Cells(as_row, 8).Value = Sheets(s).Cells(r, 8).Value
Sheets(acs).Cells(as_row, 8).Value = Sheets(acs).Cells(as_row, 6).Value & " + " & a
End If
a = ""
Next r
Next s
Next as_row
What I want is:
After adding, manually, a new sheet I want to press on a button. This button activates the code above. What I want is to check a value in a particulaire cell in column "A". If the value in this column matches with the value from previous sheet then display the value in the sixth column in the newly added sheet. The code above does that, but it works only for two sheets. If I make more then two sheets it does not display more values then two.
Update
I added my file in the link: Check.xlsm
After opening this file clear the H-column in the third (and maybe the second sheet) then run the macro within. You'll see what I mean
All I want is to get all the previous values in previous sheet displaced in column-H. For example I marked two cells with values, these values get displayed in the H-column after running the macro.
Your problem was that you were always storing in column H a value created by taking the value from column F of the current sheet and appending the value from column F of the sheet being processed within the loop. When you move to the next sheet within the loop, you're replacing the previous value with a new value.
So, when processing sheet w3-6, you first look at sheet w1-4 and generate a value of "13 + 34" and store that in sheet w3-6's cell H3. Then you look at sheet w2-5 and generate a value of "13 + 18" and replace the value of "13 + 34" currently in sheet w3-6's cell H3 with the value of "13 + 18".
Try this code instead:
Dim acs As Long, cos As Long, as_col As Long, as_row As Long
Dim s As Long
Dim as_LRow As Long
Dim ilast_row As Long
Dim r As Long
Dim a As String
cos = Sheets.Count
acs = ActiveSheet.Index
as_LRow = Sheets(acs).Cells(Sheets(acs).Rows.Count, "A").End(xlUp).Row
For as_row = 3 To as_LRow
std_number = Sheets(acs).Cells(as_row, 1).Value
'Initialise variable containing result to go into column H
a = Sheets(acs).Cells(as_row, 6).Value
'Process earlier sheets in reverse order
'(so that values will be shown in reverse order)
For s = acs - 1 To 1 Step -1
ilast_row = Sheets(s).Cells(Sheets(s).Rows.Count, "A").End(xlUp).Row
For r = 3 To ilast_row
std_number_new = Sheets(s).Cells(r, 1).Value
If std_number = std_number_new Then
'Append value to result string
a = a & " + " & Cstr(Sheets(s).Cells(r, 6).Value)
Exit For
End If
Next r
Next s
'Store result
Sheets(acs).Cells(as_row, 8).Value = a
Next as_row
I have an excel spreadsheet. In a column of the spreadsheet I have a list of codes (numbers).These codes (numbers) are sorted from highest to lowest values.(some of these codes has been repeated. For example I have three consecutive line with code 1001200).I want to insert new rows between each codes (in case of having repeated codes i just need one new row (for example i Just need one new row for 1001200 not 3 rows) .
I have written the following code but it does not work.
Sub addspace()
Dim space_1(5000), Space_2(5000)
For n = 1 To 5000
Debug.Print space_1(n) = Worksheets("sheet3").Cells(1 + n, 1).Value
Debug.Print Space_2(n) = Worksheets("sheet3").Cells(2 + n, 1).Value
Next
For n = 1 To 5000
If space_1(n) <> Space_2(n) Then
Range("space_1(n)").EntireRow.Insert
End If
Next
End Sub
How can I fix it? (From the code you can see that I am so beginner :)))
Cheers
To insert one empty row between each unique value try this:
Option Explicit
Public Sub addspace()
Dim i As Long
Application.ScreenUpdating = False
With Worksheets("sheet3")
For i = 5000 To 2 Step -1
While .Range("A" & i - 1) = .Range("A" & i)
i = i - 1
Wend
.Rows(i).Insert Shift:=xlDown
Next
End With
Application.ScreenUpdating = True
End Sub
It starts from the end row and moves up, skipping duplicates
The Range("space_1(n)") is invalid. Arg of range object should be a column name like "A1", you can use Range("A" & n).EntireRow.Insert in your code. But I recommend my code.
Please try,
Sub addspace()
Dim n As Integer
For n = 1 To 5000
If Worksheets("sheet3").Cells(n, 1).Value <> Worksheets("sheet3").Cells(n + 1, 1).Value Then
Worksheets("sheet3").Cells(n + 1, 1).EntireRow.Insert
n = n + 1
End If
Next
End Sub