Ctr + F (Find) not working

V

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,284
Office Version
  1. 365
Platform
  1. Windows
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

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
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

S
  • Question Question
Extracting/copy work sheets to new workbook based on the work sheet cell text
Replies
3
Views
185
Micron
M
R
  • Question Question
Merge Excel Multiple Sheets from a single work book to one sheet.
2
Replies
11
Views
770
rtr1811
R
B
  • Question Question
Excel hyperlink formula is not clickable when the workbook is converted to pdf
Replies
2
Views
298
bhaskarsharma03
B
S
  • Question Question
Gathering Data From Multiple Files in Same Folder in Particular Range
3 4 5
Replies
41
Views
2K
kvsrinivasamurthy
K
C
  • Solved
User Select PDF import to specific Excel sheet
2 3 4
Replies
31
Views
1K
John_w
J

Forum statistics

Threads
1,223,910
Messages
6,175,318
Members
452,634
Latest member
cpostell

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