rakietu
06-21-2012, 11:53 AM
RAW DATA:
http://img543.imageshack.us/img543/3753/rawdata.jpg
NEED DATA:
http://img525.imageshack.us/img525/5989/needdata.jpg
separate sign: $$$$
i have problem with data with empty cells (no telephone) or www.. (http://www..) to save empty space in next sheet
Sub szkajsigna()
Dim s As String, s2 As String, b As String, x As String
Dim Rng As Range, rCell As Range, signCounter As Integer
Set Rng = Range("A1:A500")
signCounter = rowCounter + 1
x = 1
For Z = 1 To 5
s = Cells.Find(What:="$$$$", After:=Cells(x, 1), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlDown, MatchCase:= _
False, SearchFormat:=False).Row
s2 = Cells.Find(What:="$$$$", After:=Cells(s, 1), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlDown, MatchCase:= _
False, SearchFormat:=False).Row
' MsgBox ("s=" & s & ", s2= " & s2)
x = s2 + 1
Set Rng = Range("A" & s, "A" & s2)
For i = s To s2
For Each rCell In Rng.Cells
If InStr(Cells(1 + i, 1).Value, "tel.") Then Sheets("Delay Duration").Range("B" & Rows.Count).End(xlUp).Offset(1) = rCell.Offset(0, 0)
' If InStr(rCell.Value, "www") Then Sheets("Delay Duration").Range("D" & Rows.Count).End(xlUp).Offset(1) = rCell.Offset(0, 0)
'If InStr(rCell.Value, "e-mail") Then Sheets("Delay Duration").Range("C" & Rows.Count).End(xlUp).Offset(1) = rCell.Offset(0, 0)
Next rCell
Next i
Next Z
End Sub
http://img543.imageshack.us/img543/3753/rawdata.jpg
NEED DATA:
http://img525.imageshack.us/img525/5989/needdata.jpg
separate sign: $$$$
i have problem with data with empty cells (no telephone) or www.. (http://www..) to save empty space in next sheet
Sub szkajsigna()
Dim s As String, s2 As String, b As String, x As String
Dim Rng As Range, rCell As Range, signCounter As Integer
Set Rng = Range("A1:A500")
signCounter = rowCounter + 1
x = 1
For Z = 1 To 5
s = Cells.Find(What:="$$$$", After:=Cells(x, 1), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlDown, MatchCase:= _
False, SearchFormat:=False).Row
s2 = Cells.Find(What:="$$$$", After:=Cells(s, 1), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlDown, MatchCase:= _
False, SearchFormat:=False).Row
' MsgBox ("s=" & s & ", s2= " & s2)
x = s2 + 1
Set Rng = Range("A" & s, "A" & s2)
For i = s To s2
For Each rCell In Rng.Cells
If InStr(Cells(1 + i, 1).Value, "tel.") Then Sheets("Delay Duration").Range("B" & Rows.Count).End(xlUp).Offset(1) = rCell.Offset(0, 0)
' If InStr(rCell.Value, "www") Then Sheets("Delay Duration").Range("D" & Rows.Count).End(xlUp).Offset(1) = rCell.Offset(0, 0)
'If InStr(rCell.Value, "e-mail") Then Sheets("Delay Duration").Range("C" & Rows.Count).End(xlUp).Offset(1) = rCell.Offset(0, 0)
Next rCell
Next i
Next Z
End Sub