I'm trying to write a macro to appear Rows depend cell value as we see in the code below :
For a = 3 To 400
If Cells(a, 5).value = reda Then
Rows(a).Hidden = False
End If
Next a
and that's working well when variable = cell.value :
reda = LS700 & Cells(a, 5).value= LS700
and not working in this case :
reda = LS700 & Cells(a, 5).value = LS700/LS740.....
thank you so much advance
Reda
You can try this, similar to answer by BigBen, he is missing start position on instr function, it work:
Dim a As Long
Dim reda As String
reda = "LS700"
For a = 3 To 400
If InStr(1, Sheet1.Cells(a, 1).Value, reda, 1) > 0 Then
Rows(a).Hidden = True
End If
Next a
This is really all you should need:
reda = "LS700"
For Each rw In ActiveSheet.Range("E3:E400").EntireRow.Rows
rw.Hidden = InStr(1, rw.Cells(1, 1).Value, reda, 1) > 0
Next
Related
So I asked this question last week and I kind of have a solution to this question, but there is just one piece that is not working. The Application.Match part does not seem to work. I am also getting results when myarray does not match with arr(1).
The original question was :
What I am trying to do with this code is to :
Go through all the files in that specified folder and all the subfolders in that folder. (The files in that folder are usually separated in 5 parts by underscore. For example, "XX1_XX2_XX3_XX4_XX5"
If any of the 3 character indicators in my myarray matches XX2 from the filename, then list XX4 on Cell(22,3) and XX5 on Cell(22,4) and keep repeating ......Cell(23,3),Cell(23,4),Cell(24,3,),Cell(24,4).....etc. I want only exact matches.. not sure how to do that.
There are some files in the folder that has only 3 underscores... so "XX1_XX2_XX3_XX4". For these files, if myarray matches XX2, then list XX4 on Cells(i,3) and show "NO INDICATOR" for Cells(i,4)
Sub tracker()
Const FPATH As String = "\\KEVINXX\FILESXX\FILES\"
Dim f As String, i, j As Long, arr, sht As Worksheet
Dim myarray As Variant
myarray = Array("XXX", "AAA", "BBB", "SBM", "SBS", "JDS", "QQQ", "WWW", "CCC", "DDD", "EEE", "XXX", "AAS", "RRR", "SSS", "KKK", "ABX")
Set sht = ActiveSheet
f = Dir("\\KEVINXX\FILESXX\FILES\")
i = 22
Do While f <> ""
'split filename on underscore
arr = Split(f, "_", 5)
If UBound(arr) >= 3 Then
If IsError(Application.Match(arr(1), myarray, 0)) Then
If UBound(arr) = 3 Then
sht.Cells(i, 3).Value = Left(arr(3), Len(arr(3)) - 5)
sht.Cells(i, 4).Value = "No Indicator"
Else
sht.Cells(i, 3).Value = arr(3)
If UBound(arr) >= 4 Then
sht.Cells(i, 4).Value = Left(arr(4), Len(arr(4)) - 5)
End If
End If
i = i + 1
End If 'no match
End If
f = Dir() 'next file
Loop
End Sub
Have you tried looping through the array
for x = 0 to 16
If IsError(Application.Match(arr(1), myarray(x), 0)) Then
If UBound(arr) = 3 Then
sht.Cells(i, 3).Value = Left(arr(3), Len(arr(3)) - 5)
sht.Cells(i, 4).Value = "No Indicator"
Else
sht.Cells(i, 3).Value = arr(3)
If UBound(arr) >= 4 Then
sht.Cells(i, 4).Value = Left(arr(4), Len(arr(4)) - 5)
End If
End If
i = i + 1
End If 'no match
next x
Be kind and rewind or leave feedback)
I need to search and to replace a specific part of a string in an Excel sheet.
Here is my code and I don't know how I can exactly search this part in each Cell.value.
my_new_string = "abc"
For each objSheet1 in objworkbook2.sheets
If objSheet1.Name = "Name1" Then
LastRow = objsheet1.UsedRange.Rows.Count + objsheet1.UsedRange.Row - 1
For i = 1 To LastRow Step 1
For j = 1 To 15 Step 1
If objExcel1.Cells(i, j).value = "xyz" Then 'Here I have to check if the Cell value contains xyz and to replace it by **my_new_string**
End if
Next
Next
End If
Next
Any help please ?
Thank you all,
this is working fine for me.
For Each objsheet1 In objworkbook2.Sheets
With objsheet1
If .Name = "BatchRun" Then
On error resume next
For i = 1 To 15 Step 1
For j = 1 To 10 Step 1
If InStr(1, .Cells(i, j).Value, my_old_string) > 0 Then
.Cells(i, j).Value = Replace(.Cells(i, j).Value, my_old_string, my_new_string)
End If
Next
Next
End If
End with
Next
I changed your method for finding the last row to one that is much more reliable.
Also you used 2 different objects to describe the same sheet, so I fixed it! ;)
Finally, you just need to use Replace method that will do the job perfectly fine, without need to test if the string is present with Instr (use it if you anything else to do if the old_string is detected)
Const my_old_string = "xyz"
Const my_new_string = "abc"
Const xlPart = 2
Const xlFormulas = -4123
Const xlByRows = 1
Const xlPrevious = 2
For Each objsheet1 In objworkbook2.Sheets
With objsheet1
If .Name = "Name1" Then
LastRow = .Cells.Find("*",.Range("A1"),xlPart,xlFormulas,xlByRows,xlPrevious,False).Row
For i = 1 To LastRow Step 1
For j = 1 To 15 Step 1
.Cells(i, j).Value = Replace(.Cells(i, j).Value, my_old_string, my_new_string)
' If InStr(1, .Cells(i, j).Value, my_old_string) Then
' .Cells(i, j).Value = Replace(.Cells(i, j).Value, my_old_string, my_new_string)
' End If
Next
Next
End If
End With
Next
I think there's a bug in InStr(), Could anyone confirm it?
For instance,
Scenario 1, keyword = "1392WG" and searchString = "11392WG", then if you use InStr(1, searchString, keyword, 1), the results will end up 1. But if the searchString = "31392WG", then the results will be 2.
Could anyone test it?
`Sub test()
Updated_Date = "2016-10-10" 'Date might need to change (values after equation, remember to add it between "")
LastRow_Sheet1 = Worksheets("Sheet1").UsedRange.Rows.Count
LastRow_Sheet2 = Worksheets("Sheet2").UsedRange.Rows.Count
For x = 3 To 3
DU_ID = Worksheets("Sheet1").Cells(x, 2).Value 'Cells(x, 2) might need to change
sting_DU_ID = UCase(CStr(DU_ID))
For y = 374 To 375
compare_DU_ID = Worksheets("Sheet2").Cells(y, 2).Value 'Cells(y, 2) might need to change
string_compare_DU_ID = UCase(CStr(compare_DU_ID))
If InStr(1, string_compare_DU_ID, "L4L", 1) >= 1 Then
If string_compare_DU_ID = sting_DU_ID Then 'If L4L in compare_DU_ID, then DU_ID definitely equals to compare_DU_ID
Worksheets("Sheet2").Cells(y, 97).Value = Updated_Date '1. Cells(y, 97) might need to change, depending on which contract date you want to update
End If
ElseIf InStr(1, string_compare_DU_ID, sting_DU_ID, 1) = 1 Then
Worksheets("Sheet2").Cells(y, 97).Value = Updated_Date
ElseIf InStr(1, sting_DU_ID, string_compare_DU_ID, 1) = 1 Then
Worksheets("Sheet2").Cells(y, 97).Value = Updated_Date
End If
Next
Next
End Sub
`
I have a Word document based on a template for invoices and a database in Excel containing two tables: Company and Person.
I want to put some string into the textbox in the userform in Word which will then be searched in Excel. Excel shall return the values to a MultiColumn-Listbox located in another UserForm (this userform will only show if there is more than 1 result for the searched string).
This is the code I have in Word to run the macro, which actually gets started:
CSearchText = UFCompanySearch.tbSearchCompany.Value 'Textbox -> Search-String
xlWB.Application.Run("SearchCompany")
This only works when SearchCompany is a sub or a function with no further specifications, so
Function SearchCompany(SearchText As String)
doesn't work as I cannot run the Macro as follows:
xlWB.Application.Run("SearchCompany("SomeCompany")") 'NOTE!
NOTE: This will NOT work!!
To fill the Listbox in the UserForm I think there is the possibility to fill it with an Excel table, so this should somehow work out.
THIS is the PROBLEM:
I cannot refer to the Search-TextBox in the Userform which is located in the word Document as neither "Doc!" nor "Doc." works. Like this I can't search the cells for the string. This is the code I have to find cells containing the string:
IF (InStr(xlComp.Cells(Row, 1), CSearchText) > 0) Or _
(InStr(xlComp.Cells(Row, 2), CSearchText) > 0) Or _
(InStr(xlComp.Cells(Row, 3), CSearchText) > 0) Then
This searches the Columns A-C for the entered string. (Code I found somewhere... I have been searching too much to know where from ^.^)
Is there a way to address the UserForm in Word or a workaround to get the "SearchText" from the userform to Excel?
I'm quite new in VBA, so the more detailed your answer the more probable I will understand it.
As I did not find a way to do it directly I got a workaround when trying:
Code in Word:
Private Sub cbFirmaSearch_Click()
ActiveDocument.FormFields("FSearchText").Result = UFFirmaSearch.txtFirmaSuchen.Value
xlWB.Application.Run "SearchFirma"
ActiveDocument.FormFields("FSearchText").Delete
Dim DFLastRow As Integer
DFLastRow = xlWB.Sheets("DataFirma").Cells(xlWB.Sheets("DataFirma").Rows.Count, "a").End(xlUp).Row
Dim lbFirmTar As ListBox
Set lbFirmTar = UFFirmaSearchList.lbFirmaSearchList
Dim Row As Integer
For Row = 2 To DFLastRow
With lbFirmTar
Dim ListIndex As Integer
ListIndex = UFFirmaSearchList.lbFirmaSearchList.ListCount
.AddItem xlWB.Sheets("DataFirma").Cells(Row, 1).Value, ListIndex
.List(ListIndex, 1) = xlWB.Sheets("DataFirma").Cells(Row, 2).Value
.List(ListIndex, 2) = xlWB.Sheets("DataFirma").Cells(Row, 3).Value
.List(ListIndex, 3) = xlWB.Sheets("DataFirma").Cells(Row, 4).Value
.List(ListIndex, 4) = xlWB.Sheets("DataFirma").Cells(Row, 5).Value
.List(ListIndex, 5) = xlWB.Sheets("DataFirma").Cells(Row, 6).Value
.List(ListIndex, 6) = xlWB.Sheets("DataFirma").Cells(Row, 7).Value
End With
Next Row
With UFFirmaSearchList
If (.lbFirmaSearchList.ListCount > 1) Then
UFFirmaSearch.Hide
.Show
ElseIf (.lbFirmaSearchList.ListCount = 1) Then
FirmaID = .lbFirmaSearchList.List(0, 0)
FirmaZusatz = .lbFirmaSearchList.List(0, 1)
FirmaName = .lbFirmaSearchList.List(0, 2)
FirmaAbteilung = .lbFirmaSearchList.List(0, 3)
FirmaAdresse = .lbFirmaSearchList.List(0, 4)
FirmaPLZ = .lbFirmaSearchList.List(0, 5)
FirmaOrt = .lbFirmaSearchList.List(0, 6)
UFFirmaSearch.lblfrFirmenangaben = "Firma ID : " & FirmaID & _
"Firmenzusatz : " & FirmaZusatz & _
"Name : " & FirmaName & _
"Firmenabteilung : " & FirmaAbteilung & _
"Adresse : " & FirmaAdresse & _
"PLZ / Ort : " & FirmaPLZ & " " & FirmaOrt
Else
MsgBox "No Entry found.", vbOKOnly
End If
End With
UFFirmaSearch.txtFirmaSuchen.SetFocus
End Sub
Code in Excel:
Sub SearchFirma()
Dim Doc As Word.Document
Set Doc = ActiveDocument
Dim xlFirm As Worksheet
Set xlFirm = ActiveWorkbook.Sheets("Firma")
Dim LastRow As Integer 'Last row on sheet "Firma" containing values
LastRow = xlFirm.Cells(xlFirm.Rows.Count, "a").End(xlUp).Row
Dim xlDatFirm As Worksheet
Set xlDatFirm = ActiveWorkbook.Sheets("DataFirma")
Dim FSearchText As String
FSearchText = Doc.FormFields("FSearchText").Result
For Row = 2 To LastRow
Dim DFNewRow As Integer 'Next free line on sheet "DataFirma"
DFNewRow = xlDatFirm.Cells(xlDatFirm.Rows.Count, "A").End(xlUp).Row + 1
If (InStr(1, xlFirm.Cells(Row, 1), FSearchText, vbTextCompare) > 0) Or (InStr(1, xlFirm.Cells(Row, 2), FSearchText, vbTextCompare) > 0) Or (InStr(1, xlFirm.Cells(Row, 3).Value, FSearchText, vbTextCompare) > 0) Or (InStr(1, xlFirm.Cells(Row, 4).Value, FSearchText, vbTextCompare) > 0) Then
xlDatFirm.Range("A" & DFNewRow).Value = xlFirm.Cells(Row, 1).Value
xlDatFirm.Range("B" & DFNewRow).Value = xlFirm.Cells(Row, 2).Value
xlDatFirm.Range("C" & DFNewRow).Value = xlFirm.Cells(Row, 3).Value
xlDatFirm.Range("D" & DFNewRow).Value = xlFirm.Cells(Row, 4).Value
xlDatFirm.Range("E" & DFNewRow).Value = xlFirm.Cells(Row, 5).Value
xlDatFirm.Range("F" & DFNewRow).Value = xlFirm.Cells(Row, 6).Value
xlDatFirm.Range("G" & DFNewRow).Value = xlFirm.Cells(Row, 7).Value
End If
Next Row
End Sub
Somehow this works. When I first tried "Dim xlWB As Excel.Workbook" in Word I would always get a runtime error. When I tried "Dim Doc As Word.Document" in Excel though I never got an error... very strange but still somehow managed to get it over with.
If you have any questions regarding this I will be happy to try to help and if there are things that I can rewrite in a better way, please don't hesitate to comment.
Thanks for the support :)
I have a userform and I want to check if a particular giftcard is present in the database or not and if found I would like to pull the values into the relevant textboxes.
I'm using the code below. This code checks for a valid gift-card (this part works).
iRow is the Last row in database
ValueToFind is the ID of gift-card
WithType is the Type of gift-card.
Code:
For i = 1 To iRow + 1
If ws.Cells(i, 2).Value = ValueToFind And _
ws.Cells(i, 1).Value = WithType And _
ws.Cells(i, 6).Value = "" Then
...
Exit Sub
End If
Next i
But I can't find a way to update the Me.TXT_MONEY.Value and Me.TXT_DATE.Value in the userform textboxes.
Can you help me with this code?
Is this what you are trying?
For i = 1 To iRow + 1
If ws.Cells(i, 2).Value = ValueToFind And _
ws.Cells(i, 1).Value = WithType And _
ws.Cells(i, 6).Value = "" Then
TXT_MONEY.Value = ws.Cells(i, X).Value
TXT_DATE.Value = ws.Cells(i, Y).Value
Exit Sub
End If
Next i
Replace X and Y in the above code with the relevant column number from where you want to pick up values.
Also instead of looping, you may actually want to use .Find? See THIS link from my blog.