I need to ensure that a row that contains certain text "Area of Activity" is in row 10 of the sourceSheet. I have some VBA working for where "Area of Activity" is in a row before row 10, and this inserts rows until that word is in said row. I'm needing to extend that code to also look if the word is in a row below row 10 (row 11, 12...). If it is, then I'd like rows to be deleted immediately above the word until it sits in row 10.
The sourceSheet is a csv file which is created from an Excel file. The issue is that sometimes the row with the words "Area of Activity" is in a row somewhere before or after row 10.
Here is what I have so far for this part:
Sub SetUp()
Dim sourceBook As Workbook
Dim targetBook As Workbook
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim count As Integer
Dim dat As Variant
Dim rng As Range
Dim i As Long
Dim answer1 As Integer
Dim answer2 As Integer
Dim answer3 As Integer
Dim answer4 As Integer
Dim crccc As Variant
Dim crcac As Variant
' Must have exactly 2 workbooks open
If Workbooks.count <> 2 Then
MsgBox "There must be exactly 2 workbooks open to run the macro", vbCritical + vbOKOnly, "Copy Columns From Source To Target"
Exit Sub
End If
' Set the source and target workbooks
Set targetBook = ActiveWorkbook
If Workbooks(1).Name = targetBook.Name Then
Set sourceBook = Workbooks(2)
Else
Set sourceBook = Workbooks(1)
End If
' Set up the sheets
Set sourceSheet = sourceBook.ActiveSheet
Set targetSheet = targetBook.ActiveSheet
'Application.ScreenUpdating = True
' Ensure Area of Activity... is in row 10
sourceSheet.Activate
Do While Range("A10") <> "Area of Activity"
If Left(Range("A10"), 16) <> "Area of Activity" Then
Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Else
Exit Do
End If
Loop
'*******************************************************************
'WHEN I RUN THE BELOW PART, THE Do While Range.... PART ABOVE HANGS.
'*******************************************************************
' If Area of Activity is after row 10 then move to row 10
Do While Range("A10") <> "Area of Activity"
If Left(Range("A10"), 16) <> "Area of Activity" Then
Rows("10:10").Delete
Else
Exit Do
End If
Loop
After your sourceSheet.Activate line, replace the remainder of your code with the following, and I think this will do the trick for you. This snippet removes/adds all rows at once instead of iterating through a loop and adding/removing rows 1 at a time, which could be time consuming. It also ensures that "Area of Activity" is in the range and provides feedback if it isn't.
Dim sToFind As String
sToFind = "Area of Activity"
'''create a Range equal to column A
Dim oRng As Range
Set oRng = sourceSheet.Columns(1)
'''create an array to store all values in column A
Dim arr_ColA_Values
arr_ColA_Values = Application.Transpose(oRng.Value)
'''create a boolean to track if we've really found the string
Dim bFound As Boolean
bFound = False
'''Test if a value in the column CONTAINS "Area of Activity"
If InStr(1, Join(arr_ColA_Values, ","), sToFind) Then
Dim lCount As Long
Dim lPosition
For lCount = LBound(arr_ColA_Values) To UBound(arr_ColA_Values)
If arr_ColA_Values(lCount) = sToFind Then
lPosition = lCount
'''change bFound to True b/c the cell value is identical
'''to "Area of Activity" instead of just containing A that value
bFound = True
Exit For
End If
Next lCount
If bFound = False Then
MsgBox "While a cell in Column A CONTAINS " & sToFind & ". No cell in Column A is IDENTICAL to " & _
sToFind & ", so the routine is ending without taking any action."
Else
'''INSERT or DELETE rows
Select Case lPosition
Case Is < 10
'''Insert rows
Rows(1).EntireRow.Resize(10 - lPosition).Insert shift:=xlDown
Case Is > 10
'''Delete rows, starting at row 10 and preserving rows 1-9
Rows(10).EntireRow.Resize(lPosition - 10).delete shift:=xlUp
Case Else '''where it's already in row 10
'''do nothing
End Select
End If
Else
MsgBox "No cells in Column A CONTAINS the value " & sToFind & ", so the routine is ending without taking any action."
End If