Ctr + F (Find) not working

V

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,232
Dear All,
I have query regarding copy-paste.
Copying data from PDF and paste into my excel book.
My excel book is macro enables, contains some code..
While performing Ctr+f option on Sheet, it is not finding the text, though it is available on sheet...

Could anyone guide me on this please..
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
no. the pasting done properly...and my code also work...but after generating output, just fro cross checking when I do manual check that time, ctr+f is not working...
Do you want to see my entire code..
 
Upvote 0
sheetspread said:
ok
Click to expand...
Code: 
Option Compare Text


Sub SplitFormDate()
Application.ScreenUpdating = False
Application.DisplayAlerts = False


Dim RowCnt1 As Integer
Dim i As Integer
With Worksheets("Sheet1")
RowCnt1 = .Range("A3").End(xlDown).Row
    For i = 3 To RowCnt1
        .Cells(i, "A").Value = Trim(.Cells(i, "A").Value)
    Next i
End With


Range("A3", Range("A3").End(xlDown)).Copy Range("AA3")


Range("AA3", Range("AA3").End(xlDown)).TextToColumns Destination:=Range("AA3"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=False, space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True


Dim LastCol As Long, LastRow As Long
LastCol = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
LastRow = Cells(Rows.Count, "AA").End(xlUp).Row


Range("AA3", Cells(LastRow, LastCol)).Select
Selection.Copy
Range("AA3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Dim FndTxt As Range, zVal As Range, Fnd As Long
Set FndTxt = Range("AA3")
'For Each zVal In Range("Z501", Range("Z" & Rows.Count).End(xlUp))
For Each zVal In Sheets("Sheet2").Range("Z501", Sheets("Sheet2").Range("Z" & Rows.Count).End(xlUp))
    **** = WorksheetFunction.CountIf(Range("AA3", Cells(LastRow, LastCol)), zVal.Value)
    If **** > 0 Then
        For Fnd = 1 To ****
            Set FndTxt = Range("AA3", Cells(LastRow, LastCol)).Find(What:=zVal.Value, After:=FndTxt, _
            LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            Range("A" & FndTxt.Row).Interior.Color = vbGreen
        Next Fnd
    End If
Next zVal


Range(Cells(1, 27), Cells(1, LastCol)).EntireColumn.Delete Shift:=xlToLeft
Range("A2").Select


Dim MLst1 As Range
Application.ReplaceFormat.Clear
Application.ReplaceFormat.Interior.Color = vbGreen
For Each MLst1 In Range("List")
    Columns("A").Replace "* " & MLst1 & " *", "", SearchFormat:=False, ReplaceFormat:=True
Next
Application.ReplaceFormat.Clear


Dim MLst2 As Range
Application.ReplaceFormat.Clear
Application.ReplaceFormat.Interior.Color = vbGreen
For Each MLst2 In Range("List")
    Columns("A").Replace "* " & MLst2, "", SearchFormat:=False, ReplaceFormat:=True
Next
Application.ReplaceFormat.Clear


'Concatenation of C & D in Col B
With Worksheets("Sheet1")
    For i = 3 To RowCnt1
    If .Cells(i, 3) = "" Then
    Else
    .Cells(i, "B").Value = .Cells(i, 3).Value & " " & .Cells(i, 4).Value
    End If
    Next i
End With


Dim R As Long, X As Long, Cnt As Long, Data As Variant
Data = Range("B3", Cells(Rows.Count, "B").End(xlUp)).Resize(, 2)
For R = 1 To UBound(Data)
  Cnt = 0
  Data(R, 2) = ""
  For X = Len(Data(R, 1)) To 1 Step -1
    If Cnt < 4 Then
      If IsNumeric(Mid(Data(R, 1), X, 1)) Then
        Cnt = Cnt + 1
        Data(R, 2) = Mid(Data(R, 1), X, 1) & Data(R, 2)
      End If
    ElseIf Cnt = 4 Then
      Data(R, 2) = Format(Data(R, 2), "@@/01/@@")
      Data(R, 1) = Left(Data(R, 1), X)
      Cnt = 5
    ElseIf IsNumeric(Mid(Data(R, 1), X, 1)) Then
      Data(R, 1) = Left(Data(R, 1), X)
      Exit For
    End If
  Next
Next
Range("F3").Resize(UBound(Data)).NumberFormat = "mm/dd/yyyy"
Range("E3").Resize(UBound(Data), 2) = Data






For i = 3 To RowCnt1
If Application.WorksheetFunction.IsText(Cells(i, 6)) = True Then
Cells(i, 6).Interior.Color = vbRed
Else
End If
Next i


For i = 3 To RowCnt1
If Right(Cells(i, 6), 4) = 1900 Or Right(Cells(i, 6), 4) = 1901 Or Right(Cells(i, 6), 4) = 1902 Then
Cells(i, 6).Interior.Color = vbRed
Else
End If
Next i




Application.ReplaceFormat.Clear
Application.ReplaceFormat.Interior.Color = xlNone
Columns("A").Replace "* in *", "", SearchFormat:=False, ReplaceFormat:=True
Columns("A").Replace "* or *", "", SearchFormat:=False, ReplaceFormat:=True
Application.ReplaceFormat.Clear
Application.ReplaceFormat.Clear
Application.ReplaceFormat.Interior.Color = vbGreen
Columns("A").Replace "-*", "", SearchFormat:=False, ReplaceFormat:=True
Application.ReplaceFormat.Clear




With Worksheets("Sheet1")
RowCnt2 = .Range("A3").End(xlDown).Row
For j = 3 To RowCnt2
    .Cells(j, "A").Value = WorksheetFunction.Proper(.Cells(j, "A").Value)
Next j
End With


'copy in new workbook
Range("A2", Range("F500").End(xlDown)).Copy
Dim wb As Workbook
Set wb = Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A2").Select


Columns("C:D").Select
Selection.EntireColumn.Delete




Dim UsdRws As Long, k As Long
Application.ScreenUpdating = False
UsdRws = Range("A" & Rows.Count).End(xlUp).Row
For k = UsdRws To 2 Step -1


'If Cells(k, 1).Interior.Color = 65535 Then
'Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
'Rows(k).Delete
'End If




If Range("A" & k).Value Like "Exclusions" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Exclusions" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Exclusions *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Exclusions *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete




ElseIf Range("A" & k).Value Like "Exclusion" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Exclusion" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Exclusion *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Exclusion *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Exclusion * " Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Exclusion-*" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
    


ElseIf Range("A" & k).Value Like "Excl" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Excl" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Excl *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "* Excl *" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Excl-* " Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
ElseIf Range("A" & k).Value Like "Excl-*" Then
    Rows(k).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows(k).Delete
End If


Next k
Application.ScreenUpdating = True






Range("A1:D1").Copy
Range("G1").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
ActiveSheet.UsedRange.Select
Selection.Copy
Sheets("sheet1").Select
Range("G2").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
ActiveSheet.UsedRange.Clear
Cells(1, 1).Select
Sheets("Sheet1").Select
ActiveWindow.Zoom = 90
Columns("E:F").Select
Selection.ColumnWidth = 4


Range("G1").Select
On Error GoTo ErrorHandler
    Dim RowCnt5 As Integer
    RowCnt5 = Range("G1").End(xlDown).Row
Exit Sub
ErrorHandler:
    For m = 2 To RowCnt5
        'Cells(m, "H").Value = Cells(m, "I") & " - " & Left(Cells(m, "J"), 2) & "/" & Right(Cells(m, "J"), 4)
        Cells(m, "H").Value = Cells(m, "I") & " - " & Format(Cells(m, "J"), "mm/yy")
    Next m


Sheets("sheet1").Select
Cells.Select
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
Cells(1, 1).Select


Application.DisplayAlerts = True
Application.ScreenUpdating = True


Call EvalData


Cells(3, 1).Select


End Sub




Sub EvalData()


Dim cel As Range
Dim rng As Range


Application.ScreenUpdating = False
Application.DisplayAlerts = False


With Worksheets("Sheet1")
Set rng = .Cells(.Rows.Count, 1).End(xlUp)
For Each cel In .Range(.[A2], rng)
cel = ConditionalCase(cel.Value)
Next cel
End With


Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub


Function ConditionalCase(ByVal str As String) As String
Dim vStr As Variant
Dim i%
Dim sTemp$


Application.ScreenUpdating = False
Application.DisplayAlerts = False


vStr = Split(str, " ")
For i = LBound(vStr) To UBound(vStr)
sTemp = vStr(i)
'remove punctuation from string segment
sTemp = Replace(Replace(Replace(Replace(Replace(Replace(sTemp, ",", ""), _
".", ""), "(", ""), ")", ""), "?", ""), "!", "")
Select Case sTemp
Case "and", "is", "for", "of", "or"
'lower case
vStr(i) = LCase(vStr(i))
Case "TRIA", "TRIPRA", "OFAC", "PPACA", "EBL", "ERISA"
vStr(i) = UCase(vStr(i))
Case Else
vStr(i) = StrConv(vStr(i), vbProperCase)
End Select
Next i
ConditionalCase = Join(vStr, " ")


Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Function
 
Upvote 0
If you're sure that text you type is found but that pasted from PDF is not (in the same ranges) then look closer at:

FndTxt = Range("AA3", Cells(LastRow, LastCol)).Find(What:=zVal.Value, After:=FndTxt, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Range("A" & FndTxt.Row).Interior.Color = vbGreen

and maybe debug.print FndTxt for different iterations
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
This is an Excel to Access porting issue - Is it possible to convert an Excel VBA FIND method to work correctly in and with Access's VBA ?
4 5 6
Replies
50
Views
1K
Trebor76
T
S
  • Question
Program Button to Find, Copy, Paste to New Sheet based on Value in column
Replies
0
Views
135
samss919
S
T
  • Question
Converting PDF data into Excel
Replies
2
Views
643
alansidman
A
C
  • Solved
VBA attach PDF to email stopped working
Replies
8
Views
646
FormR
FormR
P
  • Question
Excel to internal application
Replies
2
Views
159
pure vito
P

Forum statistics

Threads
1,214,402
Messages
6,119,304
Members
448,886
Latest member
GBCTeacher

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top