remove " and concatenate on cell colour and run RS232IP2

[sydinstaller]

Hi,
This is a tricky one to try explain, but here we go...

Usefully background info:
Following on from this post: http://www.mrexcel.com/forum/showthread.php?t=491155&highlight=RS232IP

My sheets have become much more complex and repetitive than I ever expected.

What I would like to do is:
Copy the data from between the "" in column A (Column F shows example results)
Take the data from the BLUE cell in column A and add it to the cells below it (Column G shows example results) Then at the next BLUE cell start the cycle again.

There are some GREY cells. These are not implemented so they can be ignored but it is OK if they are processed.

I need this to repeat down the entire column.

Then if possible (This is not required as I can run a separate command manually) I would like to run the RS232IP2 script in column H.

Thanks in advance.
Daniel

Excel Workbook
	A	B	C	D	E	F	G	H
1	"RES" - Monitor Out Resolution					RES
2	"00"	sets Through	Yes	Yes		00	!1RES00	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 52 45 53 30 30
3	"01"	sets Auto(HDMI Output Only)	Yes	Yes		01	!1RES01	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 52 45 53 30 31
4	"02"	sets 480p	Yes	Yes		02	!1RES02	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 52 45 53 30 32
5	"03"	sets 720p	Yes	Yes		03	!1RES03	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 52 45 53 30 33
6	"UP"	sets Monitor Out Resolution Wrap-Around Up	Yes	Yes		UP	!1RESUP	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 52 45 53 55 50
7	"QSTN"	gets The Monitor Out Resolution	Yes	Yes		QSTN	!1RESQSTN	49 53 43 50 00 00 00 10 00 00 00 0A 01 00 00 00 21 31 52 45 53 51 53 54 4E
8	"ISF" - ISF Mode					ISF
9	"00"	sets ISF Mode Custom	No	No		00	!1ISF00	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 49 53 46 30 30
10	"01"	sets ISF Mode Day	No	No		01	!1ISF01	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 49 53 46 30 31
11	"VWM" - Video Wide Mode					VWM
12	"00"	sets Auto	Yes	Yes		00	!1VWM00	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 56 57 4D 30 30
13	"01"	sets 4:3	Yes	Yes		01	!1VWM01	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 56 57 4D 30 31
14	"05"	sets Smart Zoom	No	No		05	!1VWM05	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 56 57 4D 30 35
15	"UP"	sets Video Zoom Mode Wrap-Around Up	Yes	Yes		UP	!1VWMUP	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 56 57 4D 55 50
16	"QSTN"	gets Video Zoom Mode	Yes	Yes		QSTN	!1VWMQSTN	49 53 43 50 00 00 00 10 00 00 00 0A 01 00 00 00 21 31 56 57 4D 51 53 54 4E
17	"VPM" -Video Picture Mode					VPM
18	"00"	sets Through	Yes	Yes		00	!1VPM00	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 56 50 4D 30 30
19	"01"	sets Custom	Yes	Yes		01	!1VPM01	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 56 50 4D 30 31
20	"02"	sets Cinema	Yes	Yes		02	!1VPM02	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 56 50 4D 30 32
Sheet1

Here is the code for RS232IP2

Function RS232IP2(s As String, Optional delim As String = " ") As String ' The usage would be RS232IP2(cell to change, OPTIONAL delimiter as cell referance)

Dim byt() As Byte
Dim j As Long
 
Const HEADER As String = "49 53 43 50 00 00 00 10 00 00 00 ## 01 00 00 00" ' This is the HEADDER. ## is the section where LEN calculated and is placed

 
RS232IP2 = Replace(Replace(HEADER, "##", Right("0" & Hex(Len(s) + 1), 2)), " ", delim)
byt = StrConv(s, vbFromUnicode)
For j = 0 To Len(s) - 1
    RS232IP2 = RS232IP2 & delim & Hex(byt(j))
Next j
End Function


' Thank you to PGC01 and sandeep.warrier from the MREXCEL forums for providing this script.
' http://www.mrexcel.com/forum/showthread.php?t=491155&highlight=RS232IP


' Original code before I messed with it :)

' Function RS232IP(s As String, HEADER As String, Optional delim As String = " ") As String
'    Dim j As Long
'
'    RS232IP = Replace(Replace(HEADER, "##", Right("0" & Hex(Len(s) + 1), 2)), " ", delim)
'
'    For j = 1 To Len(s)
'        RS232IP = RS232IP & delim & Hex(Asc(Mid(s, j, 1)))
'    Next j
'End Function

 

[GlennUK]

You can do that with formulas, if you can have an extra helper column, and you don't mind using an old Excel 4 Macro function inside a defined name. Would that be OK?

 

[sydinstaller]

Hi Glenn,

Not sure.

Could you please show an example?

I am willing to give anything a try.



Thanks
Dan.

 

[Peter_SSs]

Not sure if this is any use to you but from what I can see of your data here is a simpler formula for F1 copied down and then this G2 formula copied down should work for all rows rather than manually changing it for each section as you appear to have done.

Excel Workbook
	A	B	F	G
1	"RES" - Monitor Out Resolution		RES
2	"00"	sets Through	00	!1RES00
3	"01"	sets Auto(HDMI Output Only)	01	!1RES01
4	"02"	sets 480p	02	!1RES02
5	"03"	sets 720p	03	!1RES03
6	"UP"	sets Monitor Out Resolution Wrap-Around Up	UP	!1RESUP
7	"QSTN"	gets The Monitor Out Resolution	QSTN	!1RESQSTN
8	"ISF" - ISF Mode		ISF
9	"00"	sets ISF Mode Custom	00	!1ISF00
10	"01"	sets ISF Mode Day	01	!1ISF01
11	"VWM" - Video Wide Mode		VWM
12	"00"	sets Auto	00	!1VWM00
13	"01"	sets 4:3	01	!1VWM01
14	"05"	sets Smart Zoom	05	!1VWM05
15	"UP"	sets Video Zoom Mode Wrap-Around Up	UP	!1VWMUP
16	"QSTN"	gets Video Zoom Mode	QSTN	!1VWMQSTN
17	"VPM" -Video Picture Mode		VPM
18	"00"	sets Through	00	!1VPM00
19	"01"	sets Custom	01	!1VPM01
20	"02"	sets Cinema	02	!1VPM02
21
sydinstaller

 

[ZVI]

VBA solution:

Sub CreateRS232IP()
  
  Const PREFIX$ = "!1" ' prefix
  Const QT$ = """"     ' quote
  
  Dim Rng As Range, a(), b(), i&, ii&, r&, hdr$, v$
  
  ' Set input data range Rng
  With ActiveSheet
    If .FilterMode Then .ShowAllData
    Set Rng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
  End With
  
  ' Copy input data into a()
  a = Rng.Value
  
  ' Prepare output array
  ReDim b(1 To UBound(a), 1 To 3)
  
  ' Do main processing
  For r = 1 To UBound(a)
    v = Trim(a(r, 1))
    If Right(v, 1) = QT Then
      ' It's not header - delete quotes, populate b()
      v = Mid(v, 2, Len(v) - 2)
      b(r, 1) = "'" & v
      v = PREFIX & hdr & v
      b(r, 2) = v
      b(r, 3) = RS232IP2(v)
    Else
      ' Header found - extract header hdr and put it into b()
      i = InStr(v, QT)
      ii = InStr(i + 2, v, QT)
      If ii Then
        hdr = Mid(v, i + 1, ii - i - 1)
        b(r, 1) = hdr
      End If
    End If
  Next
  ' Copy b() to the destination range
  Rng.Columns("F").Resize(, 3).Value = b()
End Sub

' Modified code of PGC01 and Sandeep.Warrier http://www.mrexcel.com/forum/showthread.php?t=491155&highlight=RS232IP
' The usage would be RS232IP2(cell to change, OPTIONAL delimiter as cell referance)
Function RS232IP2(s As String, Optional delim As String = " ") As String
  Dim byt() As Byte
  Dim j As Long
  Const HEADER As String = "49 53 43 50 00 00 00 10 00 00 00 ## 01 00 00 00"  ' This is the HEADDER. ## is the section where LEN calculated and is placed
  RS232IP2 = Replace(Replace(HEADER, "##", Right("0" & Hex(Len(s) + 1), 2)), " ", delim)
  byt = StrConv(s, vbFromUnicode)
  For j = 0 To Len(s) - 1
    RS232IP2 = RS232IP2 & delim & Hex(byt(j))
  Next j
End Function

Triggering code of Sheet1:

' Put this code into Sheet1 module
Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("A:B")) Is Nothing Then Exit Sub
  Call CreateRS232IP
End Sub

 

[sydinstaller]

Hi,

Peter:
That worked great. Can you please explain how they work?

I did however find two small issues that im not sure if they can be fixed.

The issues are with the data I provided. As my sheets get bigger it would appear that different people are creating them. Sorry I just noticed them while trying these solutions.

Here are some new samples.
If then issues cannot be overcome I am happy to edit the fields manually.

Excel Workbook
	A	B
85	"SRC" - Search Command
86		Search
Command & Message

Excel Workbook
	A	B
130	"PGR" - Progressive Command
131	(No Parameter)
Command & Message

Excel Workbook
	A	B
194	"?ST" - Status requesting Command
195	* Please also see "Feedback List" below for reply message
Command & Message

Excel Workbook
	A	B
423	"SL2" - Line21_SW2 Status notice(without ATS_AOB)
424	"00"	Line21 data for field 2 is memorized.
425	"01"	Line21 data for field 2 is not memorized.
426
427	"FF"	Unknown/other
Command & Message

ZVI:
I could not work out how to make your code function.

I put the first bit of code here:
VBA Project (file name)
Modules
Module2

Module 1 is RS232IP2

And I put the second bit in:
VBA Project (file name)
Microsoft Excel Objects
Sheet1

I also tried here (as this is the page the data is on):
VBA Project (file name)
Microsoft Excel Objects
Sheet5

But I could not work out how to trigger it.

Can you please explain how to run it?


Thanks
Daniel.
http://www.excel-jeanie-html.de/index.php?f=1

 

[Peter_SSs]

Here are some new samples.
If then issues cannot be overcome I am happy to edit the fields manually.

Perhaps you could explain just what the 'issues' are and/or make up a small data set that includes these examples - together with the expected results?

 

[ZVI]

Hi Daniel,

You wrote:

I put the first bit of code here:
VBA Project (file name)
Modules
Module2

It’s ok and enough for manual running of CreateRS232IP macro.
Delete data from F:H columns and run CreateRS232IP – it will auto-populate F:H columns.
All calculations are made in macro with storing the resulting values in array b().
Finally values of b() are copied out to F:H columns.

----

And I put the second bit in:
VBA Project (file name)
Microsoft Excel Objects
Sheet1

I also tried here (as this is the page the data is on):
VBA Project (file name)
Microsoft Excel Objects
Sheet5

But I could not work out how to trigger it.

Can you please explain how to run it?

The triggering code should be copied into VBA- module of the sheet where the data are stored.
I was guessing that it’s Sheet1 as it is shown in your post #1 above the layout table.
For the general case follow the instruction below:
- Copy the triggering code to the clipboard
- Do right click on sheet name tab
- Choose “Source Code”, VBE window of the sheet module will appear
- Paste the code
- Press Alt-Q to close VBE
- Try to change value in cells of A:B columns to see the corresponding results in F:H columns.

This version of code will trigger CreateRS232IP macro at changing of A:H cells:

' Put this code into sheet module
Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("A:H")) Is Nothing Then Exit Sub
  On Error Resume Next
  Application.EnableEvents = False
  Call CreateRS232IP
  Application.EnableEvents = True
End Sub

Regards,
Vlad

 

[sydinstaller]

Opps. Sorry. Serves me right for posting while tired.

Ok, here is some more data and the errors. I can send you a copy of the sheets if that helps.

1. I do not always have F and G available. This should be an easy fix to the formula if I could understand how it works.

2. I have found that sometimes (this is new in my latest sheet) there are blank cells under the blue cell.
The below example should resolve to be !1RTP

Excel Workbook
	A	B	C	D	E	F	G
85	"RPT" - Repeat Function Command					RPT
86		Toggle Repeat Function on/off	Yes	Yes	Yes	#VALUE!	#VALUE!
Command & Message

3. Sometimes (this is also new in my latest sheet) there is (no parameter) under the blue cell. but then there is data after that.
The below example should resolve to be:
!1PGR
!1PGRDN
!1PGR00
!1PGR01

Excel Workbook
	A	B	C	D	E	F	G
128	"PGR" - Progressive Command					PGR
129	(No Parameter)		No	No	No	#VALUE!
130	"DN"	Progressive On/Off Toggle	No	No	No	DN	#VALUE!
131	"00"	Progressive Off	No	No	No	00	#VALUE!
132	01	Progressive On	No	No	No	#VALUE!	#VALUE!
Command & Message

4. Sometimes (this is also new in my latest sheet) there is a comment under the blue cell. but then there is data after that.
The below example should resolve to be:
!1?ST
!1?STST
!1?STDS
!1?STMS
ETC...

Excel Workbook
	A	B	C	D	E	F	G
192	"?ST" - Status requesting Command					?ST
193	* Please also see "Feedback List" below for reply message					Please also see
194	"ST"	Notify Action Status	Yes	Yes	Yes	ST	!1 Please also see ST
195	"DS"	Notify current disc status	Yes	Yes	Yes	DS	!1 Please also see DS
196	"MS"	Notify Dimmer Function status	Yes	Yes	Yes	MS	!1 Please also see MS
197	"FS"	Notify Sampling Rate Status	No	No	No	FS	!1 Please also see FS
198	"PS"	Notify Progressive status	No	No	No	PS	!1 Please also see PS
199	"AS"	Notify Aspect Ratio Status	Yes	Yes	Yes	AS	!1 Please also see AS
200	"CD"	Notify Current Disc status	No	No	No	CD	!1 Please also see CD
201	"SA"	Notify SACD Disc status	No	No	No	SA	!1 Please also see SA
202	"VS"	Notify Video Out status	No	No	No	VS	!1 Please also see VS
203	"IS"	Notify i.LINK Out status	No	No	No	IS	!1 Please also see IS
204	"RS"	Notify Resolution Setup Status	Yes	Yes	Yes	RS	!1 Please also see RS
205	"MA"	Notify HDMI Audio Setup Setup Status	Yes	Yes	Yes	MA	!1 Please also see MA
Command & Message

5. Sometimes (this is also new in my latest sheet) there is a blank cell between the data lines and then there is data after that.
The below example should resolve to be:
!1SL2
!1SL200
!1SL201
!1SL2
!1SL2FF

Excel Workbook
	A	B	C	D	E	F	G
421	"SL2" - Line21_SW2 Status notice(without ATS_AOB)					SL2
422	"00"	Line21 data for field 2 is memorized.	No	No	No	00	!1SL200
423	"01"	Line21 data for field 2 is not memorized.	No	No	No	01	!1SL201
424						#VALUE!
425	"FF"	Unknown/other	No	No	No	FF	#VALUE!
Command & Message

Thank you for helping.

ZVI:
I will try your one again and get back to you.


Thanks.
Daniel.

 

[sydinstaller]

Hi Vlad,

Ok that worked. Thank you.

This works great!

However as I did not have a complete set of data this code also has some minor issues with the new data.

Where the cell under the blue cell is empty it does not show a result.
So the below result should be (excluding the ","):
!1ENT , HEX CODE
!1RET , HEX CODE
!1SUP , HEX CODE

Excel Workbook
	A	B	C	D	E	F	G	H
17	"ENT" - Enter Command					ENT
18		Enter	Yes	Yes	Yes
19	"RET" - Return Command					RET
20		Return	Yes	Yes	Yes
21	"SUP" - Setup Command					SUP
22		Setup	No	No	No
Command & Message

This example is adding the commented cell below the blue cell to the results.

Excel Workbook
	A	B	C	D	E	F	G	H
192	"?ST" - Status requesting Command					?ST
193	* Please also see "Feedback List" below for reply message					Feedback List
194	"ST"	Notify Action Status	Yes	Yes	Yes	ST	!1Feedback ListST	49 53 43 50 00 00 00 10 00 00 00 12 01 00 00 00 21 31 46 65 65 64 62 61 63 6B 20 4C 69 73 74 53 54
195	"DS"	Notify current disc status	Yes	Yes	Yes	DS	!1Feedback ListDS	49 53 43 50 00 00 00 10 00 00 00 12 01 00 00 00 21 31 46 65 65 64 62 61 63 6B 20 4C 69 73 74 44 53
196	"MS"	Notify Dimmer Function status	Yes	Yes	Yes	MS	!1Feedback ListMS	49 53 43 50 00 00 00 10 00 00 00 12 01 00 00 00 21 31 46 65 65 64 62 61 63 6B 20 4C 69 73 74 4D 53
Command & Message

These two worked correctly.

Excel Workbook
	A	B	C	D	E	F	G	H
375	"SDC" - DVD Classification Status notice					SDC
376	"00"	Unknown/other	No	No	No	00	!1SDC00	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 30
377	"01"	DVD-VIDEO	No	No	No	01	!1SDC01	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 31
378	"02"	DVD-AUDIO(ATS_AOB)	No	No	No	02	!1SDC02	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 32
379	"03"	DVD-AUDIO(ATS_VOB)	No	No	No	03	!1SDC03	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 33
380	"04"	DVD-AUDIO(ATS_AMGM_VOB)	No	No	No	04	!1SDC04	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 34
381	"05"	DVD-VR	No	No	No	05	!1SDC05	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 35
382
383	"FF"	Unknown/other	No	No	No	FF	!1SDCFF	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 46 46
Command & Message

Excel Workbook
	A	B	C	D	E	F	G	H
128	"PGR" - Progressive Command					PGR
129	(No Parameter)		No	No	No
130	"DN"	Progressive On/Off Toggle	No	No	No	DN	!1PGRDN	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 47 52 44 4E
131	"00"	Progressive Off	No	No	No	00	!1PGR00	49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 47 52 30 30
132	01	Progressive On	No	No	No
Command & Message

Also.
How do I change the output cells?
Some times I need the info in CD:CF and other times in F:H. I am hapy to change the VB Script as needed.



Thanks again.
Daniel.