Deleting Specific Cells Excel - vba

What I'm trying to do is have the program go through is find a certain value from within a column of cells and see if it matches with one cell after I special paste the value, and if there is a match delete the associated cell and its row of cells. What is happening is that the special pasting part of the program is working, but the associated cells are not being deleted. To clarify, I'm trying to delete a whole row from a certain column based on whether there's a match
Dim j As Integer
Dim i As Integer
i = 2
Dim Aud_Tot As Integer
Aud_Tot = Application.InputBox("How big is your audit", , , , , , , 1)
Do While True
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
Range(Cells(i, 1), Cells(i, 22)).Copy
Range(Cells(i, 1), Cells(i, 22)).PasteSpecial xlPasteValues
For j = 2 To Aud_Tot
If Cells(j, 24).Value = Cells(i, 2).Value Then
Range(Cells(j, 24), (Cells(j, 42))).ClearContents
End If
Next j
i = i + 1
Else
Exit Do
End If
Loop

It seems you want to delete the row but you are only using ClearContents. To delete you can change that line to Range(Cells(j, 24), (Cells(j, 42))).Delete Shift:=xlShiftUp, you can also use xlShiftToLeft.
Did you want to delete the entire row or just the range you have?

Related

Improper Use of Property?

Right now, my code keeps coming up with an error when I try to run it or test it with an "Invalid use of Property" message. When I run it, the program highlights the line "Sub Update_Audit()"
In my code, I'm trying to manipulate data for an audit between 3 sheets in a workbook.The first block of my code is to paste the data of items I need to find for the audit from the original sheet onto the 3rd sheet by setting each row equal to the data of the original row in the first sheet. The second block is used to re-paste the data of found objects in the Audit to only have values rather then formulas.Then the code will iterate through the Audit list to check for the same values and delete those values on the list in the 3rd sheet. The 2nd sheet will have the list of found audit items being pasted in at the same time. The end result is 3 sheets, 1st being just the main list where all the data is collected, the 2nd being a list of found audit items, and the 3rd being left over items that need to be found at a later date.
Sub Update_Audit()
Dim j As Integer
Dim i As Integer
Dim k As Integer
Dim Aud_Tot As Integer
i = 2
Aud_Tot = Application.InputBox("How big is your audit", , , , , , , 1)
k = 2
Do While Cells(k, 24) <> ""
Tab_Data = Range(Cells(k, 24), Cells(k, 44)).Value
Worksheets(3).Activate
Range(Cells(k, 1), Cells(k, 22)).Value = Tab_Data
Worksheets(1).Activate
k = k + 1
Loop
Do While Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value)
Dataset = Range(Cells(i, 1), Cells(i, 22)).Value
Range(Cells(i, 1), Cells(i, 22)).Value = Dataset
Worksheets(2).Activate
Range(Cells(i, 1), Cells(i, 22)).Value = Dataset
Worksheets(1).Activate
For j = 2 To Aud_Tot
If CStr(Cells(j, 24).Value) = CStr(Cells(i, 2).Value) Then
Worksheets(3).Activate
Range(Cells(j, 1), (Cells(j, 22))).Delete Shift:=xlShiftUp
Worksheets(1).Activate
Exit For
End If
Next j
i = i + 1
Loop
End Sub

Loop Crashing Excel VBA

i have been having problems with getting my code to run through its conditional loop and stopping. Here is what I have:
Do While True
Dim i As Integer
i = 2
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
Range(Cells(i, 1), Cells(i, 22)).Copy
Range(Cells(i, 1), Cells(i, 22)).PasteSpecial
i = i + 1
Else
Exit Do
End If
Loop
What I'm trying to do is to get the program to check if one cells isn't empty and if another doesn't have an error in it, if that condition is met, then the program would copy a certain row and re-paste it as just it's values since some of the cells in the row is a formula. For some reason the loop doesn't exit and Excel crashes, am I missing something?
the i = 2 should be outside
Dim i As Integer
i = 2
Do While True
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
Range(Cells(i, 1), Cells(i, 22)).Copy
Range(Cells(i, 1), Cells(i, 22)).PasteSpecial
i = i + 1
Else
Exit Do
End If
Loop
Two points :
The i = 2 must be outside the while loop.
Don't use Copy and PasteSpecial. Using the clipboard will give lots of problems later on. Additionally PasteSpecial likes you to be specific with "what" PasteSpecial action you're using. Rather assign values directly.
Dim i As Integer, Dataset As Variant
i = 2
Do While True
If Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value) Then
'This seems silly, but it overwrites the cell with its value.
Dataset = Range(Cells(i, 1), Cells(i, 22)).Value
Range(Cells(i, 1), Cells(i, 22)).Value = Dataset
i = i + 1
Else
Exit Do
End If
Loop

vba compare row to column

I have a spreadsheet where column A information starts on row 6 and I have the unique values from this list as headers across the top in Row 1 starting at column D. What I want to do is if a cell in column A matches a header row, copy the information in the cell in column C to the corresponding Header.
ORIGINAL FORMAT
DESIRED FORMAT
Here is the code that I have tried but it is not giving me the desired results:
For i = 6 To lastRow
For j = 4 To lastColumn
If Cells(i, 1) = Cells(1, j) Then
wksActRawData.Cells(i, 3).Value = wksActRawData.Cells(i, j).Value
End If
Next j
Next i
Assuming you did write lastRow and lastColumn functions, the only error in your code is the data which gets the cell values
If Cells(i, 1) = Cells(1, j) Then
wksActRawData.Cells(i, 3).Value = wksActRawData.Cells(i, j).Value
End If
Which should really be the other way around, plus I'd add a line to clear the old prices, as follows
If Cells(i, 1) = Cells(1, j) Then
Cells(i, j).Value = Cells(i, 3).Value
Cells(i, 3).ClearContents
End If
It did work for me this way

Merge text from two cells in Excel into one with VBA

I received many Excel files from a client.
Their system extracted the data into a spreadsheet, but one column is having issues. If the text was too long, it would put the remaining text into the cell below it.
This causes all the other fields in that row to be blank, except for the overflow.
How can I merge cells at issue into one for all files I received?
I uploaded a screen shot of the file as an example. Notice on row 8 that H8 is the only cell. That needs to be merged with H7. Not every row is at issue though.
asuming A is the main (and empty for doubles)
asuming H holds the text
then in L1 and copy down
=H1&IF(LEN(A2),H2,"")
simplest way (then copy values from L to H and delete empty lines (simply with filter)
when having unknown number of lines (after splitting) you better use vba (or simply repeat the whole procedure till there no empty lines anymore...
doing it in VBA:
Sub testing()
Dim i As Long
While Len(Cells(i + 1, 8))
i = i + 1
While Len(Cells(i + 1, 1)) = 0 And Len(Cells(i + 1, 8))
Cells(i, 8) = Cells(i, 8) & Cells(i + 1, 8)
Rows(i + 1).Delete
Wend
Wend
End Sub
most programs skip spaces so you may want to use:
=H1&IF(LEN(A2)," "&H2,"")
or for vba change Cells(i, 8) = Cells(i, 8) & Cells(i + 1, 8) to Cells(i, 8) = Cells(i, 8) & " " & Cells(i + 1, 8)
This will concatenate the texts in H and delete the row that is not useful :
Sub test_bm11()
Dim wS As Worksheet, _
LastRow As Long, _
i As Long
Set wS = ActiveSheet
With wS
LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
For i = LastRow To 2 Step -1
If .Cells(i, "A") <> vbNullString Then
Else
.Cells(i, "H").Offset(-1, 0) = .Cells(i, "H").Offset(-1, 0) & .Cells(i, "H")
.Cells(i, "H").EntireRow.Delete
End If
Next i
End With
End Sub

Copy certain values from one to another column and deleting the original value

I want to copy values from one column to another column (into the same row) if the cell contains the word IN and delete the original value. If not, the code should proceed to the next row and perform a new test. Thus the cell in the target column will remain empty.
When I run the code in Excel nothing happens, so I don't know what is wrong.
Ideally the code should jump to the next column (8) and do the same search and paste the value into the same column (5) when it is done with the first column, but this I haven't started with yet. So I do appreciate tips for that as well :)
Sub Size()
Dim i As Integer, a As String
i = 2
a = "IN"
Do While Cells(i, 7).Value <> ""
If InStr(Cells(i, 7), a) Then
'copying the value to another column but within the same row
Cells(i, 7).Copy Cells(i, 5)
Cells(i, 7).Clear
i = i + 1
Else
i = i + 1
End If
Loop
End Sub
I found out that my first cell in column 7 was empty and thus the Do While Cells(i, 7).Value <> "" wasn't working. Hence I'm refering to a different column that always contain data. Note that the solution code also jumps to the 2 next columns in order to search for the same word.
Sub Size()
Dim i As Integer, a As String
j = 0
i = 1
a = "IN"
Range("A1").Offset(i, 0).Select
For j = 0 To 2
Do Until Selection.Value = ""
If InStr(Range("G1").Offset(i, j).Value, a) Then
Range("E1").Offset(i, 0).Value = Range("G1").Offset(i, j).Value
Range("G1").Offset(i, j).Clear
i = i + 1
Range("A1").Offset(i, 0).Select
Else
i = i + 1
Range("A1").Offset(i, 0).Select
End If
Loop
i = 1
Range("A1").Offset(i, 0).Select
Next j
End Sub