I have a file of some 500-600 lines (with great potential to grow). It started as an xml file and after an auto-read the table created has a varying number of blank cells between the header information and the remainder. The same amount of information exists per line. I need each line to contain contiguous data.
Imagine the yellow squares are cells with information. The top grid is how it comes to me. The middle is how desperately need it. The last is an ideal wherein the remaining table-formatted columns go away (also something I know how to do rather easiily).
I would appreciate any and all help.
Not sure I understand the real requirement, but if you start with data like:
and you select the cells in column A for the rows you want to process and run this:
Sub FixLines()
Dim r As Range, N As Long, i As Long, RR As Long
For Each r In Selection
RR = r.Row
N = Cells(RR, Columns.Count).End(xlToLeft).Column
If N <> 1 Then
For i = N To 1 Step -1
If Cells(RR, i).Value = "" Then
Cells(RR, i).Delete (xlShiftToLeft)
End If
Next i
End If
Next r
End Sub
You will end up with:
Here is one way to do it (you could also use code to just move content to the left).
Option Explicit
Function Delete_Blank_Cells()
Dim lRow As Long
Dim lCol As Long
Dim LastRow As Long
Dim LastCol As Long
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).column
For lRow = 1 To LastRow
For lCol = 1 To LastCol
If Cells(lRow, lCol) = "" Then
Cells(lRow, lCol).Delete Shift:=xlToLeft
End If
Next
If lRow > 5 Then
MsgBox "Exit code - remove after testing!!"
Exit Function
End If
Next
End Function
Related
During counting blank cells I have an issue due to xlUp.That formula range is working only the cell till that there is a value.For instance let assume that
my range is K9:K208 and I have a 155 blank cells. But if there is any value on K205 than it is count as 152 even if has to be 155.How can I handle this issue?
Sub RoundedRectangle2_Click()
Dim lLastRow As Long
lLastRow = Cells(Rows.Count, 11).End(xlUp).Row
Range("A4") = WorksheetFunction.CountIf(Range("K9:K" & lLastRow), "")
End Sub
xlUp is for determining first non-blank cell upwards from starting cell, so Cells(Rows.Count, 11).End(xlUp) will start looking from last row in column K upwards. In your case that will be K208 - that is how you should determine last row (Cells(Rows.Count, 11).End(xlUp).Row).
Having lastRow=208 you can loop starting from 9th row in K column (K9), like
For i = 9 To lastRow and count all blank cells - this will guarantee that you won't miss anything :)
Here's code to get you started:
Sub CountBlanks()
Dim i, lastRow As Long
lastRow = Cells(Rows.Count, 11).End(xlUp).Row
For i = 9 To lastRow
'check if cell is blank and do any other operations
Next
End Sub
Here is an alternate method of locating a 'last row' across many columns.
dim lastRow as long
with worksheets("sheet1")
lastRow = .cells.find("*", after:=.cells(1), _
searchorder:=xlbyrows, searchdirection:=xlprevious).row
.Range("A4") = WorksheetFunction.CountIf(.Range("K9:K" & lastRow), "")
end with
I got 3000 rows of data in Excel.
Each row contains the same type of information but not in the right order.
What i need to do is to gather the same type of information under the same column.I would like to create a macro that is going to:
Search a row for a partial string (some values have similar strings but fall under different categories)
If the string is part of a cell copy the entire cell in a
new location
Repeat for the next row
Thanks in advance
Sub MoveColumns()
Dim LastRow As Long
Dim rFind As Range
Dim r As String
Dim m As Integer
LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
MsgBox (LastRow)
For n = 1 To LastRow
r = n & ":" & n
Range(r).Select
With Range(r)
Set rFind = .Find(What:="Spain*", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
If rFind.Column < 6 Then
m = 6 - rFind.Column
Range(Cells(n, 1), Cells(n, m)).Insert Shift:=xlToRight
ElseIf rFind.Column > 6 Then
m = rFind.Column - 6
Range(Cells(n, 1), Cells(n, m)).Delete Shift:=xlToLeft
End If
End If
End With
Next
End Sub
UPDATED
If row doesn't contain any value starts with "Spain", this row is simply ignored and skipped.
I hope you can modify and customize the way suitable for your data.
Text “endofdata” in col B identifies the boundaries of multiple ranges on a single sheet. I’m trying to step through each range and remove duplicate values in columns E and F within each range. I also call a routine that deletes blank rows that are generated when duplicates are removed. The bottom row with “endofdata” is always removed when .removeduplicates is executed.
I’ve tried the Do loop but it’s failing. (It works for the first range but fails for the next range) Please suggest how to make this work. What kind of loop should I use? How should I search for “endofdata” string? Thank you very much in advance.
Sub RemoveDupsinRange()
Dim LastRow As Long, i As Long, startRow, EndRow
Call setSheets
LastRow = wsQC.Cells(wsQC.Rows.Count, "A").End(xlUp).Row
Debug.Print LastRow
For i = LastRow To 1 Step -1
Do
If wsQC.Cells(i, 2).Value = "endofdata" Then
startRow = i
End If
i = i - 1
Loop Until wsQC.Cells(i, 2).Value = "endofdata"
EndRow = i
i = i - 1
Range(startRow & ":" & EndRow).Select
Selection.removeduplicates Columns:=Array(5, 6), _
Header:=xlNo
Call DeleteBlanks
Next i
End Sub
I just tested this loop and it worked.
Sub RemoveDupsinRange()
Dim LastRow As Long, i As Long, rStart As Range, rEnd As Range
Call setSheets
LastRow = wsQC.Cells(wsQC.Rows.Count, "A").End(xlUp).Row
Debug.Print LastRow
Set rEnd = wsQC.Cells(LastRow, 2)
For i = LastRow To 2 Step -1
Do
i = i - 1
If wsQC.Cells(i, 2).Value = "endofdata" Then
Set rStart = wsQC.Cells(i, 2)
End If
Loop Until wsQC.Cells(i, 2).Value = "endofdata"
wsQC.Range(rStart.Offset(, -1), rEnd.Offset(, 4)).RemoveDuplicates Columns:=Array(5, 6), Header:=xlNo
Set rEnd = rStart
Call DeleteBlanks
Next i
End Sub
So I'm writing a VBA to try and automate some data analysis which will loop through the data and anytime the time difference in the row is more than a second delay (resolution of data is higher) it will add a blank row indicating a new 'test run' of data. Then I want to delete any rows (call RangeA) inbetween the blank rows if RangeA is say 2 seconds (i.e. a short test run that is meaningless).
I've managed to create some temperamental code that adds the blank rows, but it comes back with 'type mismatch' in my if statement.
I do then need to create a chart from this data later on, so I'm not sure if adding blank rows is the best way or it will cause issues later on.
EDIT - found that some cells had strings in them due to some macro I had messed around with earlier. So it now does seperate the data with a blank row, it's now a case of trying to eliminate anything in each block that is less than 2 seconds.
Sub dataSeperator()
Dim rowStart As Long
Dim rowEnd As Long
Dim rowLoop As Long
Dim FindColumn As Range
rowStart = 3
rowEnd = Sheets("Data").UsedRange.Rows(Sheets("Data").UsedRange.Rows.Count).row
With Sheets("Data")
Set FindColumn = Cells.Find(What:="Time", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False)
End With
For rowLoop = rowEnd To rowStart Step -1
With Sheets("Data").Cells(rowLoop, FindColumn.Column)
If Cells(rowLoop - 1, FindColumn.Column) - Cells(rowLoop, FindColumn.Column) < -1 Then
.EntireRow.Insert
End If
End With
Next rowLoop
End Sub
My first answer still stands, but in my opinion you could improve the readability and simplicity of the code if you work as follows. What do you think?:
Sub Seperator2()
Const TableHeaderRowNumber As Long = 1
Dim cellTableHeaderWithTime As Range
Dim rngMyTable As Range
Dim rngMyColumnOfTimes As Range
Dim rowStart As Long
Dim rowEnd As Long
Dim lngCounter As Long
With Sheets("Data")
Set cellTableHeaderWithTime = .Cells.Find(What:="Time", After:=.Cells(TableHeaderRowNumber, 1) _
, LookIn:=xlValues _
, LookAt:=xlWhole _
, MatchCase:=False)
rowStart = TableHeaderRowNumber + 2
rowEnd = .UsedRange.Rows(.UsedRange.Rows.Count).Row
Set rngMyTable = .Range(.Cells(rowStart, cellTableHeaderWithTime.Column), .Cells(rowEnd, cellTableHeaderWithTime.Column))
' Just get the column of cells you need to compare
Set rngMyColumnOfTimes = Intersect(rngMyTable, cellTableHeaderWithTime.EntireColumn)
For lngCounter = rngMyColumnOfTimes.Cells.Count To rowStart Step -1
'rngMyTable(lngCounter) is shorthand for rngMyTable.item(lngCounter)
With rngMyTable(lngCounter)
Debug.Print .Address
If .Offset(-1, 0) - .Value < -1 Then
.EntireRow.Insert
End If
End With
Next lngCounter
End With
End Sub
I hope this helps.
Seperator()
Dim rowStart As Long
Dim rowEnd As Long
Dim rowLoop As Long
Dim FindColumn As Range
rowStart = 3
With Sheets("Data")
rowEnd = .UsedRange.Rows(.UsedRange.Rows.Count).row
' replaced "Cells" with ".cells"
Set FindColumn = .Cells.Find(What:="Time", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= xlWhole, MatchCase:=False)
End With
For rowLoop = rowEnd To rowStart Step -1
With Sheets("Data").Cells(rowLoop, FindColumn.Column)
' Used .Value instead
' "Cells" refers to the active sheet!
' use Sheets("Data").Cells instead
If Sheets("Data").Cells(rowLoop - 1, FindColumn.Column) - .value < -1 Then
' If Cells(rowLoop - 1, FindColumn.Column) - Cells(rowLoop, FindColumn.Column) < -1 Then
.EntireRow.Insert
End If
End With
Next rowLoop
End Sub
I've found this method for finding the last data containing row in a sheet:
ws.Range("A65536").End(xlUp).row
Is there a similar method for finding the last data containing column in a sheet?
Lots of ways to do this. The most reliable is find.
Dim rLastCell As Range
Set rLastCell = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
MsgBox ("The last used column is: " & rLastCell.Column)
If you want to find the last column used in a particular row you can use:
Dim lColumn As Long
lColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
Using used range (less reliable):
Dim lColumn As Long
lColumn = ws.UsedRange.Columns.Count
Using used range wont work if you have no data in column A. See here for another issue with used range:
See Here regarding resetting used range.
I know this is old, but I've tested this in many ways and it hasn't let me down yet, unless someone can tell me otherwise.
Row number
Row = ws.Cells.Find(What:="*", After:=[A1] , SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Column Letter
ColumnLetter = Split(ws.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Cells.Address(1, 0), "$")(0)
Column Number
ColumnNumber = ws.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Try using the code after you active the sheet:
Dim J as integer
J = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If you use Cells.SpecialCells(xlCellTypeLastCell).Row only, the problem will be that the xlCellTypeLastCell information will not be updated unless one do a "Save file" action. But use UsedRange will always update the information in realtime.
I think we can modify the UsedRange code from #Readify's answer above to get the last used column even if the starting columns are blank or not.
So this lColumn = ws.UsedRange.Columns.Count modified to
this lColumn = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1 will give reliable results always
?Sheet1.UsedRange.Column + Sheet1.UsedRange.Columns.Count - 1
Above line Yields 9 in the immediate window.
Here's something which might be useful. Selecting the entire column based on a row containing data, in this case i am using 5th row:
Dim lColumn As Long
lColumn = ActiveSheet.Cells(5, Columns.Count).End(xlToLeft).Column
MsgBox ("The last used column is: " & lColumn)
I have been using #Reafidy method/answer for a long time, but today I ran into an issue with the top row being merged cell from A1-->N1 and my function returning the "Last Column" as 1 not 14.
Here is my modified function now account for possibly merged cells:
Public Function Get_lRow(WS As Worksheet) As Integer
On Error Resume Next
If Not IsWorksheetEmpty(WS) Then
Get_lRow = WS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim Cell As Range
For Each Cell In WS.UsedRange
If Cell.MergeCells Then
With Cell.MergeArea
If .Cells(.Cells.Count).Row > Get_lRow Then Get_lRow = .Cells(.Cells.Count).Row
End With
End If
Next Cell
Else
Get_lRow = 1
End If
End Function
Public Function Get_lCol(WS As Worksheet) As Integer
On Error Resume Next
If Not IsWorksheetEmpty(WS) Then
Get_lCol = WS.Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Dim Cell As Range
For Each Cell In WS.UsedRange
If Cell.MergeCells Then
With Cell.MergeArea
If .Cells(.Cells.Count).Column > Get_lCol Then Get_lCol = .Cells(.Cells.Count).Column
End With
End If
Next Cell
Else
Get_lCol = 1
End If
End Function
Here's a simple option if your data starts in the first row.
MsgBox "Last Row: " + CStr(Application.WorksheetFunction.CountA(ActiveSheet.Cells(1).EntireRow))
It just uses CountA to count the number of columns with data in the entire row.
This has all sorts of scenarios where it won't work, such as if you have multiple tables sharing the top row, but for a few quick & easy things it works perfect.