Check if cell contains !

[ThomasOES]

I'm submitting a chemistry report but some of the elements are listed in % and some in ppm. I want to change all elements to %. The elements reported in ppm have an exclamation point in the cell containing the element symbol. I would like vba to copy each column and place the copied data two rows below. In the cases where an element is ppm, Multiply the data by 0.0001 and place data two rows below. I've pasted some sample data below. The Boron(B), Calcium(Ca), and Magnesium(Mg) are all reported by a spectrometer in ppm. I want to change the report to %. I would place the data beginning at cell A100. Top row would end at cell L100. Something like, Range("A100:L100").Select. If any cells have "!" Then cell End(xlDown)*0.0001.

Make This

Sample	Al	As	B!	C	Ca!	Co	Cr	Cu	Mg!*	Mn	Mo
A-1	0.0004	0.005	2.96	0.369	14.9	0.0075	0.155	0.244	2.05	0.76	0.0464
A-2/B-1	0.0008	0.0046	2.72	0.358	17.31	0.0075	0.154	0.24	3.41	0.77	0.0457
B-2	0.0008	0.0041	2.78	0.358	17.51	0.0075	0.154	0.242	2.45	0.768	0.0456
C-1	0.0009	0.0043	2.43	0.357	16.53	0.0075	0.155	0.243	2.18	0.756	0.0458
C-2/D-1	0.0006	0.0043	2.52	0.358	18.46	0.0077	0.155	0.243	2.46	0.759	0.0458
D-2	0.0006	0.0051	2.84	0.367	15.03	0.0075	0.155	0.242	2.47	0.773	0.0464
E-1	0.0006	0.0043	2.75	0.361	15.76	0.0078	0.155	0.242	2.33	0.765	0.0461
E-2/F-1	0.0006	0.0048	2.75	0.355	17.35	0.0075	0.154	0.241	2.22	0.755	0.0456
F-2	0.0006	0.0046	2.77	0.366	15.98	0.0073	0.154	0.242	2.27	0.771	0.0458

<colgroup><col width="64" style="width:48pt" span="12"> </colgroup><tbody>
</tbody>

Look Like This

Sample	Al	As	B!	C	Ca!	Co	Cr	Cu	Mg!*	Mn	Mo
A-1	0.0004	0.005	0.00030	0.369	0.00149	0.0075	0.155	0.244	0.00205	0.76	0.0464
A-2/B-1	0.0008	0.0046	0.00027	0.358	0.00173	0.0075	0.154	0.24	0.00341	0.77	0.0457
B-2	0.0008	0.0041	0.00028	0.358	0.00175	0.0075	0.154	0.242	0.00245	0.768	0.0456
C-1	0.0009	0.0043	0.00024	0.357	0.00165	0.0075	0.155	0.243	0.00218	0.756	0.0458
C-2/D-1	0.0006	0.0043	0.00025	0.358	0.00185	0.0077	0.155	0.243	0.00246	0.759	0.0458
D-2	0.0006	0.0051	0.00028	0.367	0.00150	0.0075	0.155	0.242	0.00247	0.773	0.0464
E-1	0.0006	0.0043	0.00028	0.361	0.00158	0.0078	0.155	0.242	0.00233	0.765	0.0461
E-2/F-1	0.0006	0.0048	0.00028	0.355	0.00174	0.0075	0.154	0.241	0.00222	0.755	0.0456
F-2	0.0006	0.0046	0.00028	0.366	0.00160	0.0073	0.154	0.242	0.00227	0.771	0.0458

<colgroup><col width="64" style="width:48pt" span="12"> </colgroup><tbody>
</tbody>

Sometimes the exclamation isn't the right-most character
Round to 5 digits

Any help is greatly appreciated
Tom

 

[engineer69]

You will need to determine how you want to trigger the event (I used the double-click event), but this should work.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim theLastRow As Integer
Dim dataValue As Variant

theCopiedData = Range("A1:L10").Copy
Range("A13").PasteSpecial

For Each dataValue In Range("J14:J22")
Range("J" & dataValue.Row) = dataValue * 0.0001
Next
Range("A1").Select
Application.CutCopyMode = False
End Sub

 

[MickG]

Try:-

[COLOR="Navy"]Sub[/COLOR] MG11Apr09
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Rngac [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] Range, Mpy [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A100"), Range("A" & Rows.Count).End(xlUp))
Rng.Resize(, 12).Copy Rng.Offset(Rng.Count + 2)
[COLOR="Navy"]Set[/COLOR] Rngac = Rng(1).Offset(Rng.Count + 2).Resize(, 12)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ac [COLOR="Navy"]In[/COLOR] Rngac
 [COLOR="Navy"]If[/COLOR] InStr(Ac, "!") > 0 [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]Set[/COLOR] Mpy = Ac.Offset(1).Resize(Rng.Count - 1)
        Mpy.Value = Application.Round(Evaluate(Mpy.Address & "*0.0001"), 5)
 [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[ThomasOES]

Thanks Mick
I'm busy doing other analysis, but I need to mention the sample data I posted will vary. Sometimes different elements or different number of elements. Also variable number of samples. Can the code have flexibility to accommodate changing numbers of rows and columns?

Thanks
Tom

 

[MickG]

Try this:-
This code should take care of varying numbers of columns and rows, and paste the copied version 2 rows after the end of the data starting "A100".

[COLOR="Navy"]Sub[/COLOR] MG12Apr32
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Rngac [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] Range, Mpy [COLOR="Navy"]As[/COLOR] Range
Lst = Cells("100", Columns.Count).End(xlToLeft).Column
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A100"), Range("A" & Rows.Count).End(xlUp))
Rng.Resize(, Lst).Copy Rng.Offset(Rng.Count + 2)
[COLOR="Navy"]Set[/COLOR] Rngac = Rng(1).Offset(Rng.Count + 2).Resize(, 12)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Ac [COLOR="Navy"]In[/COLOR] Rngac
 [COLOR="Navy"]If[/COLOR] InStr(Ac, "!") > 0 [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]Set[/COLOR] Mpy = Ac.Offset(1).Resize(Rng.Count - 1)
        Mpy.Value = Application.Round(Evaluate(Mpy.Address & "*0.0001"), 5)
 [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[ThomasOES]

Thanks Mick
Works perfectly. Your code allows me to finish a huge project. Cant thank you enough.
Tom

 

[MickG]

You're welcome

 

[ThomasOES]

Hello Mick
I made an alteration to your code

[COLOR=#000080]Set[/COLOR] Rngac = Rng(1).Offset(Rng.Count + 2).Resize(, 12)

I believe the Resize property needs to match the number of columns
I changed your code to

[COLOR=#000080]Set[/COLOR] Rngac = Rng(1).Offset(Rng.Count + 2).Resize(, Lst)

After my edit, I stepped through the code and it would cycle the same number of columns. Before the edit it would cycle 12 times. I hope I'm correct that the edit affects the number of columns.
Thanks
Tom

 

[MickG]

Yes !!, sorry about that I failed to update "12" with "lst" in all the places.
Hope its working for OK now !!