Solved: Search For String

[Shums]

Hi All,

I am trying to add ClearContents at the beginning to below code, but its gives me error & I would like to add 1000 before this customer number 85175, i,e 100085175 when it moves its data to CABGOC sheet........please help:


Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 5
LSearchRow = 5

'Start copying data to row 5 in CABGOC (row counter variable)
LCopyToRow = 5

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column K = "85175", copy entire row to CABGOC
If Range("K" & CStr(LSearchRow)).Value = "85175" Then

'Select row in Revenue_Summary to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into CABGOC in next row
Sheets("CABGOC").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Sheet1 to continue searching
Sheets("Revenue_Summary").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell A5
Application.CutCopyMode = False
Range("A5").Select

MsgBox "All CABGOC Customer Data Has Been Copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

[CatDaddy]

Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 5
LSearchRow = 5

'Start copying data to row 5 in CABGOC (row counter variable)
LCopyToRow = 5

Do While Len(Range("A" & LSearchRow).Value) > 0

'If value in column K = "85175", copy entire row to CABGOC
If Range("K" & LSearchRow).Text = "85175" Then

'Append "1000"
Range("K" & LSearchRow).Value = "1000" & Range("K" & LSearchRow).Value

'Select row in Revenue_Summary to copy
Range("A" & LSearchRow).EntireRow.Copy Destination:=Sheets("CABGOC").Range("A" & LCopyToRow)

'Clear Contents
Range("A" & LSearchRow).EntireRow.ClearContents

'Move counter to next row
LCopyToRow = LCopyToRow + 1

End If

LSearchRow = LSearchRow + 1

Loop

'Position on cell A5
Application.CutCopyMode = False
Range("A5").Select

MsgBox "All CABGOC Customer Data Has Been Copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."
Err.Clear
Resume Next

End Sub

[CatDaddy]

maybe a little better:
Sub alex()
For Each cell In Range("K5:K" & Range("A5").End(xlDown).Row)
On Error Resume Next
If cell.Text = "85175" Then
cell.Text = "1000" & cell.Text
cell.EntireRow.Copy Destination:=Sheets("CABGOC").Range("A" & Sheets("CABGOC").Range("A5").End(xlDown))
cell.EntireRow.ClearContents
End If
Next cell
Range("A5").Select
MsgBox "All CABGOC Customer Data Has Been Copied."
End Sub

[Shums]

Sir CatDaddy,

Both the code moves the entire row from revenue sheet to cabgoc sheet, I just wanted to copy and paste special values.

[CatDaddy]

which special values?

[Shums]

I mean it must copy the row if strings are matched, but it moves completely for "85175".

[CatDaddy]

if what strings are matched? this was not in your original question

[Shums]

Sorry Sir, If I confused you, I apologize from the beginning.....

Actually I am running text wizard, which extracts txt file to excel, then few vlookups & concatenate functions an lastly it runs Search For String module(pasted above) which I found on net, which is also working fine with my other module, but it was not clearing the previous months data and copying the current month data, so I asked your help if you can help me in clearcontents in the beginning before running search for string.

Actually below code working fine now with your help of your Append "1000", but still its not clearingcontent.


Sub SearchForCabGoc()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 5
LSearchRow = 5

'Start copying data to row 5 in CABGOC (row counter variable)
LCopyToRow = 5

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column K = "85175", copy entire row to CABGOC
If Range("K" & CStr(LSearchRow)).Value = "85175" Then

'Select row in Revenue_Summary to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into CABGOC in next row
Sheets("CABGOC").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Append "1000"
Range("K" & LCopyToRow).Value = "1000" & Range("K" & LCopyToRow).Value

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Revenue_Summary to continue searching
Sheets("Revenue_Summary").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on last cell
Application.CutCopyMode = False

Exit Sub

Err_Execute:
MsgBox "An Error Occurred."

End Sub


When I adding your code, it moves entire row from revenue sheet to cabcog sheet. Please advice.....

[CatDaddy]

clear the contents of what, thats what i thought you wanted

[Shums]

Sir,

As I said I am receiving txt file every month, I have vba which runs text wizard populating data and bringing it to Revenue Sheet. From Revenue Sheet I need to split between Cabcog & Non-Cabcog, which I was trying to run through Search for String module. Now data for previous month is already exist in this workbook, so for next month if I want to run complete modules, first it must clear the content of all the worksheet in this workbook. The text wizard clears the content of Revenue Sheet, but last for String module which is running for cabgoc sheet, I am getting error. Hope its clear now.

[CatDaddy]

Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.UsedRange.ClearContents
Next ws

something like that at the beginning of your code?

[Shums]

Sir,

ws.usedrange.clearcontents is already used while text wizard, when I was trying with
Dim wsC As Worksheet
wsC.UsedRange.ClearContents

it was giving me error.

[Shums]

I tried this as well:

Sub ClearContents()
Dim ws As Worksheet, LR As Long
For Each ws In Worksheets(Array("CABGOC", "NON-CABGOC"))
With ws
LR = .Range("A5").End(xlDown).Row
.Range("A5:M" & LR).ClearContents
End With
Next ws
End Sub



but no luck

[Shums]

Sir,

I tried below in the beginning:

Sheets("CABGOC").UsedRange.ClearContents


And it worked perfectly.

How to mark this thread as solved? I am using google chrome.