Selecting Cell Reference by Matching Text in VBA

Tech1_uk

New Member
Joined
Sep 22, 2018
Messages
17
I'm very much a novice when it comes to Marcos & VBA but after reading loads of posts on this great forum, so far have managed to achieve the basic on what I'm trying to do.
Now I'm a little stuck and getting out of depth!

So I have a user form with one button that allows a txt file with a fair bit of data to be imported to an active sheet, this works 100% and I have delimit rules all working.

In this data the first 24 rows are not required so are deleted, this works 100%
Now I need to search in the remaining data for text a string in a field select the 96 cells to the right of this and then a unlimited number of rows down. The reason for this is that the text file that is import this data does not always sit in the same place but it does have the same column title every time.

Below are 2 examples of data after it has been imported, I need to select VOLTAGE 01 through to VOLTAGE 96. As you can see if data it sits in E1 and then C1. After this data is selected it then opens and pastes to a new sheet which then is turn into a graph.
If I enter the data range into my coding it works but I need to automatic do this with one click from the user form.

Data 1


Monitor ItemBATT LEVEL (%)HV BATTERY TEMPIR SEN SHORT PULSEVOLTAGE 01VOLTAGE 02VOLTAGE 03VOLTAGE 04
04841.6666674528.643914391439143910
0.054841.6666674528.643914391439143910
0.14841.6666674528.643914391439143910
0.154841.6666674528.643914391439143910
0.24841.6666674528.643914391439143910
0.254841.6666674528.643914391439093910
0.34841.6666674528.643914391439093910

<tbody>
</tbody>
<strike></strike>
Data 2


Monitor ItemBATT LEVEL (%)VOLTAGE 01VOLTAGE 02VOLTAGE 03VOLTAGE 04VOLTAGE 05VOLTAGE 06
048391439143914391039093914
0.0548391439143914391039093914
0.148391439143914391039093914
0.1548391439143914391039093914
0.248391439143914391039093914
0.2548391439143909391039093914
0.348391439143909391039093914

<tbody>
</tbody>
<strike></strike>
I have a little bit of code that will find the text string and will open a message box with it's cell reference,

Code:

Dim rngX As Range Set rngX = Worksheets("Sheet2").Range("A1:DZ10000").Find("VOLTAGE 01", lookat:=xlPart) If Not rngX Is Nothing Then MsgBox "Found at " & rngX.Address End If
The result for this find I need to add the cells to the right (96 in my case) and then rows down to include all of the data as this varies too.

This is my code from VBA which is very rough at the moment.


Private Sub CommandButton1_Click()
MyFile = Application.GetOpenFilename(, , "Browse For Battery Data")

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & MyFile, Destination:=Range("$A$1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
' CleanData
'
Rows("1:24").Select
Selection.Delete Shift:=xlUp

' Selectdata
Range("K1:DB1203").Select
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
ActiveSheet.Name = "Data"
' graph
Sheets.Add After:=ActiveSheet
ActiveSheet.Shapes.AddChart2(227, xlLine).Select
Application.CutCopyMode = False
ActiveChart.SetSourceData Source:=Sheets("Data").Range("A1:CR1202")
ActiveSheet.Shapes("Chart 1").IncrementLeft -531
ActiveSheet.Shapes("Chart 1").IncrementTop -181.1249606299
ActiveSheet.Shapes("Chart 1").ScaleWidth 3.85, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 1").ScaleHeight 2.5555555556, msoFalse, _
msoScaleFromTopLeft


End Sub
I'm not sure if this a simple thing to do or very complex and help would be great.

many thanks

Steve

<strike></strike><strike></strike><strike></strike>
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Does the code below select the right area after you have removed the 24 rows?

Code:
Sub xxxxx()
    Dim lr As Long
    lr = Worksheets("Sheet2").Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
    Worksheets("Sheet2").Rows(1).Find("VOLTAGE 01", lookat:=xlPart).Resize(lr, 96).Select
End Sub

Make sure that Sheet2 is the activesheet when running the code are it is using Select.
 
Last edited:
Upvote 0
Does the code below select the right area after you have removed the 24 rows?

Code:
Sub xxxxx()
    Dim lr As Long
    lr = Worksheets("Sheet2").Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
    Worksheets("Sheet2").Rows(1).Find("VOLTAGE 01", lookat:=xlPart).Resize(lr, 96).Select
End Sub

Make sure that Sheet2 is the activesheet when running the code are it is using Select.

Many thanks that works a treat (quite simple too).

I've now run into the next problem for the graph, as the rows now vary on Worksheet Data I need the .range to match to select only the fields that contain data.

Code:
[COLOR=#000000][FONT=Calibri]ActiveChart.SetSourceData Source:=Sheets("Data").Range("A1:CR1202")[/FONT][/COLOR]
 
Upvote 0
Maybe (untested)...

Code:
ActiveChart.SetSourceData Source:=Sheets("Data").Range("A1:CR" & Sheets("Data").Columns("A:CR").Find("*", , xlValues, , xlByRows, xlPrevious).Row)
 
Upvote 0
On that I get the following error,

Run-time error '91'

Object Variable or with Block variable not set

I'm not sure where and if I set a variable.
 
Upvote 0
I've cracked and got it working, I used this in the end.

Code:
Set Rng = Sheets("Data").Range("A1:CR" & Sheets("Data").Columns("A:CR").Find("*", , xlValues, , xlByRows, xlPrevious).Row)
ActiveChart.SetSourceData Source:=Rng

Thanks for all your help
 
Upvote 0

Forum statistics

Threads
1,214,515
Messages
6,119,972
Members
448,933
Latest member
Bluedbw

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