fari1
Active Member
- Joined
- May 29, 2011
- Messages
- 362
i've a code, that finds some particular text and trims the rows and paste them in a separate sheet.
i want to amend the code to do the following ,
my first column contains some particular text that is Apple, Bat, Cat, Deer,Ear and the 3rd column contains some description of it, for each row in Column 1 against Text A, there are two row values and i want the 2nd row value, explained below
Columns 1-------------- 2------------ 3------------- 4
Row
---------A----------------------- Apple Fruit
--------------------------------Its is used in food
---------B -----------------------Bat Sports
--------------------------------its used in playing
---------C----------------------- Cat Animal
-----------------------------------its a pet
---------D -----------------------Deer Animal
--------------------------------its found in zoo
---------E -----------------------Ear Body Part
-----------------------------------used to hear
i need every 2nd cell value from column C, which are against apple ,Cat and Ear, e.g in this case, its used in food,its a pet,used to hear and copy them in sheet2
i've a code for this, but first it is based upon anyotrher criteria,2nd its a loop, which i dun want,3rd it is quiet long.
i want to amend the code to do the following ,
my first column contains some particular text that is Apple, Bat, Cat, Deer,Ear and the 3rd column contains some description of it, for each row in Column 1 against Text A, there are two row values and i want the 2nd row value, explained below
Columns 1-------------- 2------------ 3------------- 4
Row
---------A----------------------- Apple Fruit
--------------------------------Its is used in food
---------B -----------------------Bat Sports
--------------------------------its used in playing
---------C----------------------- Cat Animal
-----------------------------------its a pet
---------D -----------------------Deer Animal
--------------------------------its found in zoo
---------E -----------------------Ear Body Part
-----------------------------------used to hear
i need every 2nd cell value from column C, which are against apple ,Cat and Ear, e.g in this case, its used in food,its a pet,used to hear and copy them in sheet2
i've a code for this, but first it is based upon anyotrher criteria,2nd its a loop, which i dun want,3rd it is quiet long.
Code:
Sub test()
Dim LastRow As Long
Dim shin As Worksheet
Set shin = Sheets("info")
shin.Select
LastRow = [a65536].End(xlUp).Row
For i = LastRow To 22 Step -1
shin.Cells(i, "a").Value = RTrim(Cells(i, "a").Value)
Select Case shin.Cells(i, "a").Value
Case "Bat"
'nothing
Case "Cat"
'nothing
Case "Deer"
'nothing
Case "Ear"
'nothing
Case ""
'nothing
Case Else
Rows(i & ":" & i + 1).Delete
End Select
Next i
Call test2
Call Macro1
Call iblank
End Sub
Sub test2()
Dim LastRow As Long
Dim shin As Worksheet
Set shin = Sheets("info")
shin.Select
LastRow = [a65536].End(xlUp).Row
For i = LastRow To 22 Step -1
shin.Cells(i, "a").Value = RTrim(Cells(i, "a").Value)
Select Case shin.Cells(i, "a").Value
Case ""
'nothing
Case Else
Rows(i).Delete
End Select
Next i
End Sub
Sub Macro1()
Dim i As Long
Dim j As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Sheets("info")
Set sh2 = Sheets("filter")
i = sh1.Cells(sh1.Rows.Count, "C").End(xlUp).Row
sh1.Cells(22, "C").Resize(i - 21).copy
sh2.Range("A20").PasteSpecial Paste:=xlPasteValues
sh2.Range("A" & (i - 1) & ":A" & sh2.Rows.Count).ClearContents
End Sub
Sub iblank()
Dim j As Long
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim k(), ka, i As Long, n As Long
Set sh2 = Sheets("filter")
Set sh3 = Sheets("URLs")
j = sh2.Cells(sh2.Rows.Count, "G").End(xlUp).Row
sh3.Columns("A:D").ClearContents
sh3.UsedRange.Columns(1).Offset(1).ClearContents
ka = sh2.Cells(20, "G").Resize(j - 19)
ReDim k(1 To UBound(ka, 1), 1 To 1)
For i = 1 To UBound(ka, 1)
If Len(WorksheetFunction.Trim(ka(i, 1))) Then
n = n + 1
k(n, 1) = ka(i, 1)
End If
Next
sh3.Range("a2").Resize(n).Value = k
End Sub
Last edited:
