VBA ARRAY CODE HELP

roykana

Board Regular
Joined
Mar 8, 2018
Messages
180
Office Version
  1. 2010
Platform
  1. Windows
Dear all master,
Please help for vba array code remove numbers based on specific contents of cell.

ORIIGINAL
ORIGINAL.PNG




RESULT

RESULT.PNG


So remove the numbers based on the contents of the word "KANA".


Thanks

roykana
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
2,006
paste the code into a module, then run ClearNumsVia1Word.
enter the name of the person to find, it will erase the numbers.

Code:
Sub ClearNumsVia1Word()
Dim vWord, vChr
Dim i As Integer
Dim vCellVal
vWord = InputBox("Enter name to find", "Remove # from name")
If vWord = "" Then Exit Sub
vWord = UCase(vWord)
Range("A1").Select
While ActiveCell.Value <> ""
   vCellVal = UCase(ActiveCell.Value)
   If InStr(vCellVal, vWord) > 0 Then
     
      'MsgBox vCellVal, , "found"
      For i = Len(vCellVal) To 1 Step -1
          If Not IsNumeric(Mid(vCellVal, i, 1)) Then
            ActiveCell.Value = Left(vCellVal, i)
            GoTo skipNext
          End If
         
      Next
   End If
   
skipNext:
   ActiveCell.Offset(1, 0).Select  'next row
Wend
End Sub
 

roykana

Board Regular
Joined
Mar 8, 2018
Messages
180
Office Version
  1. 2010
Platform
  1. Windows
paste the code into a module, then run ClearNumsVia1Word.
enter the name of the person to find, it will erase the numbers.

Code:
Sub ClearNumsVia1Word()
Dim vWord, vChr
Dim i As Integer
Dim vCellVal
vWord = InputBox("Enter name to find", "Remove # from name")
If vWord = "" Then Exit Sub
vWord = UCase(vWord)
Range("A1").Select
While ActiveCell.Value <> ""
   vCellVal = UCase(ActiveCell.Value)
   If InStr(vCellVal, vWord) > 0 Then
    
      'MsgBox vCellVal, , "found"
      For i = Len(vCellVal) To 1 Step -1
          If Not IsNumeric(Mid(vCellVal, i, 1)) Then
            ActiveCell.Value = Left(vCellVal, i)
            GoTo skipNext
          End If
        
      Next
   End If
  
skipNext:
   ActiveCell.Offset(1, 0).Select  'next row
Wend
End Sub

Thank you for your reply. I want to immediately set the name in the code and I try 5000 records running very slowly. if you make a vba array code it might be faster
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,824
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Don't quote whole posts. Just a bunch of extra clutter.
Refer to a Post number if required.
Code:
Sub Maybe_So()
Dim c As Range
    For Each c In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If Left(c, 4) = "KANA" Then c.Value = Left(c, InStrRev(c, " ") - 1)
    Next c
End Sub
Code:
Sub Or_Maybe_So()
Dim aArr, i As Long
aArr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    For i = LBound(aArr) To UBound(aArr)
        If Left(aArr(i, 1), 4) = "KANA" Then aArr(i, 1) = Left(aArr(i, 1), InStrRev(aArr(i, 1), " ") - 1)
    Next i
Range("A1").Resize(UBound(aArr)) = Application.Index(aArr, , 1)
End Sub
Code:
Sub Or_Maybe_Even_So()
Const strCol = "A" ' column
Const strText = "KANA" ' text to look for
Dim lngLast As Long, c As Range
lngLast = Range(strCol & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
    With Range(strCol & "1:" & strCol & lngLast)
        .AutoFilter Field:=1, Criteria1:=strText & "*"
            For Each c In Range("A2:A" & lngLast).SpecialCells(12)    'strCol & "1:" & strCol & lngLast).Offset(1).SpecialCells(12)
                c.Value = Left(c, InStrRev(c, " ") - 1)
            Next c
        .AutoFilter
    End With
Application.ScreenUpdating = True
End Sub
 

roykana

Board Regular
Joined
Mar 8, 2018
Messages
180
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Don't quote whole posts. Just a bunch of extra clutter.
Refer to a Post number if required.
Code:
Sub Maybe_So()
Dim c As Range
    For Each c In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If Left(c, 4) = "KANA" Then c.Value = Left(c, InStrRev(c, " ") - 1)
    Next c
End Sub
Code:
Sub Or_Maybe_So()
Dim aArr, i As Long
aArr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    For i = LBound(aArr) To UBound(aArr)
        If Left(aArr(i, 1), 4) = "KANA" Then aArr(i, 1) = Left(aArr(i, 1), InStrRev(aArr(i, 1), " ") - 1)
    Next i
Range("A1").Resize(UBound(aArr)) = Application.Index(aArr, , 1)
End Sub
Code:
Sub Or_Maybe_Even_So()
Const strCol = "A" ' column
Const strText = "KANA" ' text to look for
Dim lngLast As Long, c As Range
lngLast = Range(strCol & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
    With Range(strCol & "1:" & strCol & lngLast)
        .AutoFilter Field:=1, Criteria1:=strText & "*"
            For Each c In Range("A2:A" & lngLast).SpecialCells(12)    'strCol & "1:" & strCol & lngLast).Offset(1).SpecialCells(12)
                c.Value = Left(c, InStrRev(c, " ") - 1)
            Next c
        .AutoFilter
    End With
Application.ScreenUpdating = True
End Sub
dear Jolivanes,
sorry I'm late to reply to you. thank you very much for your reply
of the three codes running perfectly. There is a little problem I want to ask you.
1. If I use the text "kana" with 100,000 records, the error is in the "Sub Or_Maybe_So()" code, which is run time error 13.
What is the cause and what is the solution?.
2. If the text is more than one what to use code like "Sub toCall() Call Call call End Sub" or any other solution from you.

Thanks
roykama
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
50,601
Office Version
  1. 365
Platform
  1. Windows
2. If the text is more than one what to use ..
Can you be more specific with what you have and what you are trying to achieve?

Also, when you get a code error, please give the full error message and identify which line of the code gives the error.
 

roykana

Board Regular
Joined
Mar 8, 2018
Messages
180
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Can you be more specific with what you have and what you are trying to achieve?
it means that the text criteria are more than one example I use text"kana","budi","joko" so what is the solution in the code. whether to call each sub code for each text or is there another solution. And I just want the process to be fast for many records. from the code that jolivanes gave it was perfect, there was only an error in one of the codes because 100,000
the record. the code below:
VBA Code:
Sub Or_Maybe_So()
Dim aArr, i As Long
aArr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    For i = LBound(aArr) To UBound(aArr)
        If Left(aArr(i, 1), 4) = "KANA" Then aArr(i, 1) = Left(aArr(i, 1), InStrRev(aArr(i, 1), " ") - 1)
    Next i
Range("A1").Resize(UBound(aArr)) = Application.Index(aArr, , 1) 'error in this line
End Sub
Thanks
roykana
 

Attachments

  • ERROR-1.PNG
    ERROR-1.PNG
    5.3 KB · Views: 10
  • ERROR-2.PNG
    ERROR-2.PNG
    12.8 KB · Views: 10

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
50,601
Office Version
  1. 365
Platform
  1. Windows
I have not been able to reproduce that error on that line of the code, even with 1000,000 rows.

Does it make any difference if you change that marked line to this?
VBA Code:
Range("A1").Resize(UBound(aArr)) = aArr

Do you have any error values in the column?
 

roykana

Board Regular
Joined
Mar 8, 2018
Messages
180
Office Version
  1. 2010
Platform
  1. Windows
I have not been able to reproduce that error on that line of the code, even with 1000,000 rows.

Does it make any difference if you change that marked line to this?
VBA Code:
Range("A1").Resize(UBound(aArr)) = aArr

Do you have any error values in the column?
no error found
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,824
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Any good reason why the 20+ lines of code from Post #2 are repeated in Post #3?
Any good reason why the 30+ lines of code from Post #4 are repeated in Post #5?
Just read the very first line of Post #4 again.
 

Forum statistics

Threads
1,141,284
Messages
5,705,510
Members
421,399
Latest member
hjweiss00

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
Top