Experts Exchange Solution brought to you by
"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.
Dim wsData As Worksheet, wsOut As Worksheet
Dim lr As Long, c As Long, lc As Long, cnt As Long
Dim Num As String
Dim Rng As Range, Cell As Range
Dim FirstAddress As String
Application.ScreenUpdating = False
Set wsData = Sheets("Sheet1")
Set wsOut = Sheets("DTAOUT")
lr = wsData.Cells(Rows.Count, "J").End(xlUp).Row
Set Rng = wsData.Range("J4:J" & lr)
Num = InputBox("Please input the Number to be find")
c = 2
Set Cell = .Find(Num, lookat:=xlWhole)
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
cnt = cnt + 1
wsOut.Cells(1, c) = Num
wsOut.Cells(2, c) = "OCCURRENCE " & cnt
Cell.Offset(0, -3).Resize(10, 7).Copy wsOut.Cells(4, c)
Set Cell = .FindNext(Cell)
c = c + 8
Loop While Not Cell Is Nothing And FirstAddress <> Cell.Address
lc = wsOut.Cells(4, Columns.Count).End(xlToLeft).Column
If lc > 1 Then
For c = 2 To lc Step 8
wsOut.Cells(1, c).Resize(2, 7).Interior.Color = RGB(255, 192, 0)
wsOut.Cells(1, c).Resize(1, 7).Merge
wsOut.Cells(1, c).HorizontalAlignment = xlCenter
wsOut.Cells(2, c).Resize(1, 7).Merge
wsOut.Cells(2, c).HorizontalAlignment = xlCenter
Application.ScreenUpdating = True
Open in new window
While there were several headline-grabbing ransomware attacks during in 2017, another big threat started appearing at the same time that didn’t get the same coverage – illicit cryptomining.
Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.
From novice to tech pro — start learning today.
Members can enroll in this course at no extra cost.