Insert or Delete column if does not equal heading - vba

I have column headings starting in Column L going forward. The column headings need to be in a certain order.
By hand, I have to insert columns so everything is in order. I put insert or delete in the question title because I assume it's easy to go between the two.
I have no idea how to start this. I have code for deleting rows when a observation is appended with "Total". However, how do I change it so it works for columns?
LR = ThisWorkbook.Sheets("Cheese_D").Range("A" & Rows.Count).End(xlUp).Row
With ThisWorkbook.Sheets("Cheese")
For i = LR To 2 Step -1
With ThisWorkbook.Sheets("Cheese").Range("A" & i)
If Right(.Value, 5) = "Total" Then .EntireRow.Delete
End With
Next i
End With

One way to look at columns in a range is like this:
Set rng = Range("L:S")
For Each col In rng.Columns
'do your logic and .EntireColumn.Delete
next
Or look at all columns in sheet like this:
For Each col in ThisWorkbook.Sheets("Cheese").Columns
'your logic
Next
Now to add in your logic:
Set rng = Range("L:S")
For Each col In rng.Columns
If Cells(1, col.Column).Value = "Total" Then col.EntireColumn.Delete
next
These four lines replace all your code in the original post.

Related

Excel Table : add blank columns and headers vba

I have an excel table and I want to add a column to it and then name the header. Somehow my old codes don't work anymore, and I am not sure if it has anything to do with me making the data range a table (Name is Table1). Now the codes run through with no error but only add the blank column but did not add a header. I pressed F8 and it looks like it skips Select portion and jumps to the end.
Table is specified from column A to column AG. I used to be able to insert multiple blank columns and add the headers just fine. Now I don't want to specify cell position and assign a cell value to it (cell(1, 32).value ="Month") since I want to have the flexibility to be add however many columns I need and add the header respectively like before.
Sub Ins_Blank_Cols_Add_Headers()
Columns("AF:AG").Insert Shift:=xlToRight
Columns("AF:AF").Cells(1, 1) = "<<NewHeader>>"
Columns("AG:AG").Cells(1, 1) = "<<NewHeader>>"
Dim cnter As Integer
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
cnter = 0
For i = 1 To LastCol
If Cells(1, i) Like "<<NewHeader>>*" Then
Select Case cnter
Case 0: Cells(1, i).Value = "Month"
Case 1: Cells(1, i).Value = "Year"
End Select
cnter = cnter + 1
End If
Next i
End Sub
Stop using Range.Select and Selection, it will do you good.
Also always use fully qualified ranges.
Your issue is that when you insert a column in Table, Excel automatically assigns a header name to it.
So your IF condition to check empty fails. Hence No Select case invocation
Change this
Columns("AF:AF").Select
Selection.Insert Shift:=xlToRight
To
Columns("AF:AF").Insert Shift:=xlToRight
Columns("AF:AF").Cells(1, 1) = "<<NewHeader>>" ' In Table Can't set blank header so use a place holder.
Also Change the If Condition from
If IsEmpty(Cells(1, I)) Then
To
If Cells(1, I) Like "<<NewHeader>>*" Then

Return Column Header of Colored Cells

This process is being used for QC purposes. I have a spreadsheet that highlights certain cells that are wrong based off of their values and the validation rules we have in place. I was wonder if there was a way to return the column names of each cell that is colored into column A for each row? So for example if D2, F2, and G2 are wrong it would put all of those column headers in A2 to specify what exactly is wrong. I know it gets a bit more complicated trying to automate stuff with cell colors and I am not experienced in VBA which I'm assuming this will need. Is this possible to do, if so what would be the proper route to take? The data runs from column A to column BS, and the row numbers may differ, so if it could run up to row 1,000 that would be great. Attached is what the data looks like that I am working with.
The red means something is wrong in that row, and the orange cell is the color indicating that it is a wrong value
Yes, it is possible to do. Here is some snippets of code I pulled together to help get you started.
Lastrow = Cells(Rows.count, "A").End(xlUp).Row 'Get last row
With ActiveSheet
Lastcol = .Cells(1, .Columns.count).End(xlToLeft).Column 'Get last col
End With
For x = 1 To Lastcol 'Iterate Col
For i = 1 To Lastrow 'Iterate Row
'if red....
If Cells(i, x).Selection.Interior.Color = 255 then
'Move name to Cell A and append off of old name(s).
Cells(i, "A") = Cells(i, "A") & ", " & Cells(i, x)
End If
Next i 'next row
Next x 'next col

Looping until blank column

I am putting together some VBA code which i think needs a loop. Loops are often my biggest weakness with VBA and I need some assistance.
I have a text file which i import into an excel spreadsheet. The length of how many columns and rows and down will vary day to day.
For example today's file might have data in columns A - H, tomorrow it might be A : P. Each typical row count will be around the 200 mark, so not to long.
In essence im trying to make one long list in column A from all the data spread over multiple columns.
Im looking for a loop that checks if the column has data in it, if it does it then copies the data into the bottom of the data in column A.
So for illustration purposes say the data goes out to column G, it will copy B1, xl down, find the first empty row in A and paste, then do the same for C, stopping after column G.
I hope I’ve been clear when writing this.
Thanks in advance
Matt
You first want to loop over all columns. So a FOR loop from column B to LastColumn (which there is a function for.) Then you want to loop through all rows within that column to find the first empty row, and then substract one to arrive at the last column with data.
If Cells(row,col) = "" Then
LastRowCopy = row -1
Then you want to copy everything to A1, and keep track of the last row you posted in. So you want to have a variable that counts. Something like:
LastRowPaste = LastRowPaste + row
I could write the code for it, but perhaps you learn more by figuring it out yourself.
Edit: Also perhaps an interesting read on finding last rows and or columns is this: http://www.rondebruin.nl/win/s9/win005.htm
Edit2: You could ofcourse also use the same for finding the last column as the method I used for finding the last row. Then you just loop through the columns and see if:
If Cells(1, col) = "" Then
LastCol = col -1
Edit3:
I wrote out the entire code:
Sub copypaste()
Dim LastRowCopy As String
Dim LastRowPaste As String
Dim LastCol As String
Dim col As Integer
Dim row As Integer
LastCol = ActiveSheet.UsedRange.Columns.Count
LastRowCopy = ActiveSheet.UsedRange.Rows.Count
LastRowPaste = ActiveSheet.UsedRange.Rows.Count
For row = 1 to LastRowPaste
If Cells(row, 1) = "" Then
LastRowPaste = row
Exit For
End if
Next row
For col = 2 To LastCol
If Application.WorksheetFunction.CountA(Columns(col)) = 0 Then
LastCol = col -1
End If
Next col
For col = 2 To LastCol
For row = 1 To LastRowCopy
If Not Cells(row, col) = "" Then
Cells(LastRowPaste, 1) = Cells(row, col)
LastRowPaste = LastRowPaste + 1
End If
Next row
Next col
End Sub

macro to insert blank rows based on column value

I'm unsuccessfully trying to create a macro to insert blank row based on cell value.
I have a bulk data, in which one column has differing numbers. Based on the column value, I need to insert a blank row below it.
If I understand you properly this should do what you want.
Just change "A:A" to the range your working with and the If cell.Value = 1 Then to the condition you need to find the cell you want to add a blank row under.
Dim i As Range
Dim cell As Range
Set i = Range("A:A")
For Each cell In i.Cells
If cell.Value = 1 Then
cell.Offset(1).EntireRow.Insert
End If
Next
The below is an example for if you are looking to insert a blank row based on a sudden change of value in a column (in this case column "C"):
Dim lRow As Long
For lRow = Cells(Cells.Rows.Count, "C").End(xlUp).Row To 3 Step -1
If Cells(lRow, "C") <> Cells(lRow - 1, "C") Then Rows(lRow).EntireRow.Insert
Next lRow
You can change Cells(lRow - 1, "C") to whatever value you want to trigger your row insert and, of course, what column this is being applied to.

EXCEL VBA- Average all rows containing numerical values for each column in a Merged Area

I have multiple spreadsheets that each roughly look like this:
I'm trying to find a way to go through each of the SPEAKER HEADERS in Row 1, and summarize the scores that are associated with the corresponding survey question ("Was the CONTENT good? Was the SPEAKER relevant? What the DELIVERY good?) grouped by color.
I can't think of a clever way of doing this automatically.
I can get the RANGE SPANS of the Merged Cells like this:
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
MsgBox Cell.MergeArea.Address
End If
Next
I then need to iterate over the range provided by the address, getting the numerical values in all the rows BELOW that range.
For example, running the current macro produces this:
I need to take $C$1:$E$1 and run a for loop that say FROM C1 to E1 average all the numbers in the rows below it. I have no idea how to do this.
I was thinking about augmenting the selection in include everything used
Is there a better way to do this?
This is the tragically bad way I'm doing it now (which I'm quite proud of on account of being new to excel):
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
Set rng = Range(Cell.MergeArea.Address) 'Equal to the Address of the Merged Area
startLetter = Mid(rng.Address, 2, 1) 'Gets letter from MergeArea Address
endLetter = Mid(rng.Address, 7, 1) 'Gets letter from MergeArea Address
On Error GoTo ErrHandler:
Set superRange = Range(startLetter & ":" & endLetter)
ErrHandler:
endLetter = startLetter
Set superRange = Range(startLetter & ":" & endLetter)
Resume Next
superRange.Select
MsgBox Application.Average(Selection)
In order to get rid of the error you are having, you need to change:
Set rng = Cell.MergeArea.Address
to
Set rng = Range(Cell.MergeArea.Address)
Ideally, this data would be better stored in a database so that it could be queried easily. If that's not an option, then the way you are going at it in Excel is as valid as most any other approach.
EDIT
Once you obtain the address of the left-most column for each of your speakers, you can loop through each column to obtain averages.
'Number of columns in the current speaker's range.
numColumns = rng.Columns.Count
'First row containing data.
currentRow = 4
'First column containing data.
firstColumn = rng.Column
'Loop through each column.
For col = firstColumn to firstColumn + (numColumns -1)
totalValue = 0
'Loop through each row.
Do While Cells(currentRow,col).value <> ""
totalValue = totalValue + Cells(currentRow,col).Value
currentRow = currentRow + 1
Loop
averageValue = totalValue / (currentRow - 3)
'Reset the currentRow value to the top of the data area.
currentRow = 4
'Do something with this average value before moving on to the next column.
Next
If you don't know what row is the start of your data, you can keep checking every row below rng.Row until you hit a numeric value.
The method above assumes that you have no blank entries in your data area. If you have blank entries, then you should either sort the data prior to running this code, or you would need to know how many rows you must check for data values.