remove " and concatenate on cell colour and run RS232IP2

sydinstaller

New Member
Joined
Aug 26, 2010
Messages
23
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
ABCDEFGH
1"RES" - Monitor Out ResolutionRES
2"00"sets ThroughYesYes00!1RES0049 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)YesYes01!1RES0149 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 480pYesYes02!1RES0249 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 720pYesYes03!1RES0349 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 UpYesYesUP!1RESUP49 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 ResolutionYesYesQSTN!1RESQSTN49 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 ModeISF
9"00"sets ISF Mode CustomNoNo00!1ISF0049 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 DayNoNo01!1ISF0149 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 ModeVWM
12"00"sets AutoYesYes00!1VWM0049 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:3YesYes01!1VWM0149 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 ZoomNoNo05!1VWM0549 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 UpYesYesUP!1VWMUP49 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 ModeYesYesQSTN!1VWMQSTN49 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 ModeVPM
18"00"sets ThroughYesYes00!1VPM0049 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 CustomYesYes01!1VPM0149 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 CinemaYesYes02!1VPM0249 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

Code:
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
 
Last edited:
Something are still not clear, the rules declaration is required.

I would suggest the following rules:

1. Processing data are in A column
2. There are two types of data, i.e. headers and values
3. If the first and the last symbols of the data are (double) quotes then it’s the value between the quotes
4. If the first symbol of data is quote but last one isn’t the quote then it’s the header between the quotes
5. Headers or values should be copied into F column
6. For rows with header the result in H:G columns are empty cells
7. For rows with value the result in G column is the concatenation of the string prefix !1 with header and with value, for example: !1RES00
8. If data cell value is string (No Parameter) then result in G column is concatenation of the prefix !1 with header, for example: !1RES
9. In H column there should be return of RS232IP2 function with passed value of G-cell into it.
10. Rows with empty cell in A:B column are skipped, result in F:H columns for such rows are empty cells.
11. Rows with empty cell in A column but with non empty cell in B column are processed, result in G column is concatenation of the prefix !1 with header, for example: !1RES

Please change the rules as required and post the updated one.

P.S. I willl provide you the constant declaration in the code for the 1st destination row
 
Last edited:
Upvote 0

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
One more rule:

12. Rows are skipped if header or value or keyword (refer to rule #8) is not found in the data cell of A column. Such value is the comment, the result in F:H column are empty cells in this case.
 
Upvote 0
To check the rules the below is layout with input data, the corresponding results and the code.
Let me know if something is not correct.
Excel Workbook
ABCDEFGH
1"RES" - Monitor Out ResolutionRES
2"00"sets ThroughYesYes00!1RES0049 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)YesYes01!1RES0149 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 480pYesYes02!1RES0249 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 720pYesYes03!1RES0349 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 UpYesYesUP!1RESUP49 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 ResolutionYesYesQSTN!1RESQSTN49 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 ModeISF
9"00"sets ISF Mode CustomNoNo00!1ISF0049 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 DayNoNo01!1ISF0149 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 ModeVWM
12"00"sets AutoYesYes00!1VWM0049 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:3YesYes01!1VWM0149 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 ZoomNoNo05!1VWM0549 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 UpYesYesUP!1VWMUP49 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 ModeYesYesQSTN!1VWMQSTN49 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 ModeVPM
18"00"sets ThroughYesYes00!1VPM0049 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 CustomYesYes01!1VPM0149 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 CinemaYesYes02!1VPM0249 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 56 50 4D 30 32
21"SRC" - Search CommandSRC
22Search!1SRC49 53 43 50 00 00 00 10 00 00 00 06 01 00 00 00 21 31 53 52 43
23(No Parameter)!1SRC49 53 43 50 00 00 00 10 00 00 00 06 01 00 00 00 21 31 53 52 43
24
25"PGR" - Progressive CommandPGR
26(No Parameter)!1PGR49 53 43 50 00 00 00 10 00 00 00 06 01 00 00 00 21 31 50 47 52
27"DN"Progressive On/Off ToggleDN!1PGRDN49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 47 52 44 4E
28"00"Progressive Off00!1PGR0049 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 47 52 30 30
29"01"rogressive On01!1PGR0149 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 47 52 30 31
30"?ST" - Status requesting Command?ST
31* Please also see "Feedback List" below for reply message
32"ST"Notify Action StatusST!1?STST49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 3F 53 54 53 54
33"DS"Notify current disc statusDS!1?STDS49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 3F 53 54 44 53
34"SL2" - Line21_SW2 Status notice(without ATS_AOB)SL2
35"00"Line21 data for field 2 is memorized.00!1SL20049 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 4C 32 30 30
36"01"Line21 data for field 2 is not memorized.01!1SL20149 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 4C 32 30 31
37
38"FF"Unknown/otherFF!1SL2FF49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 4C 32 46 46
Sheet


The code:
Rich (BB code):

' ZVI:2011-03-20 http://www.mrexcel.com/forum/showthread.php?t=536660
' Version 02
Sub CreateRS232IP()
  
  ' --> Settings, change to suit
  Const DESTCOL$ = "F"                ' The 1st column of the destination range
  Const PREFIX$ = "!1"                ' Output prefix
  Const NOPARAM$ = "(No Parameter)"   ' Keyword of A column (refer to the rules)
  Const QT$ = """"                    ' Quote symbol
  ' <-- End of the settings
  
  Dim Rng As Range, a(), b(), i&, ii&, r&, hdr$, v$
  
  ' Set input data range Rng
  With ActiveSheet
    Set Rng = .UsedRange.Columns("A")
  End With
  
  ' Copy input data into a()
  a = Rng.Resize(, 2).Value
  
  ' Prepare output array
  ReDim b(1 To UBound(a), 1 To 3)
  
  ' Do main processing
  For r = 1 To UBound(a)
    If VarType(a(r, 1)) = vbString Then
      v = Trim(a(r, 1))
      i = InStr(3, v, QT) ' position of 2nd quote
      If i > 2 Then
        If Left$(v, 1) = QT Then
          If i = Len(v) Then
            ' Extract value, populate b() for F:H column
            v = Mid$(v, 2, i - 2)
            b(r, 1) = "'" & v
            v = PREFIX & hdr & v
            b(r, 2) = v
            b(r, 3) = RS232IP2(v)
          Else
            ' Extract header, put it into b() for F column
            hdr = Mid$(v, 2, i - 2)
            b(r, 1) = hdr
          End If
        End If
      Else
        If StrComp(v, NOPARAM) = 0 Then
          ' NOPARAM keyword found - populate b() for G:H column without value
          v = PREFIX & hdr
          b(r, 2) = v
          b(r, 3) = RS232IP2(v)
        End If
      End If
    Else
      If VarType(a(r, 2)) = vbString Then
        If Len(Trim(a(r, 2))) > 0 Then
          ' Cell A is empty but cell B isn't empty - populate b() for G:H column without value
          v = PREFIX & hdr
          b(r, 2) = v
          b(r, 3) = RS232IP2(v)
        End If
      End If
    End If
  Next
  
  ' Copy b() to the destination range
  Rng.Columns(DESTCOL).Resize(, UBound(b, 2)).Value = b()

End Sub

' Modified code of PGC01 and Sandeep.Warrier http://www.mrexcel.com/forum/showthr...hlight=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
 
Last edited:
Upvote 0
Hi,
Here are the two original files im working with.

http://www.mediafire.com/?cg4a97j5xtr22

What you wrote is correct but just to confirm.

All data to be processed is in column A
There are two types of data.
a. Headers, these are in the blue cells. between " "
b. the cells below the header are the data. Between " "

The header and the data need to be concatenated togeather preceded with !1

In other words:
The BLUE cell (header) needs to have the info between the "" added to the DATA (under blue cell) also between ""

This then needs !1 added to the front.

If there is a empty cell under the header then it should just be !1header

If there is anything other than Data or Blank it should be ignored. I can manually delete them at the end if it cannot be skipped.

In the next column there should be the RS232IP2 results.

Results in cells F:G should be variable. As sometimes these already have data in them. I am happy to manually change the VBA to do this.

I don't actuall need the break down of the header and data to be seperate. That was just a carry over of using formulas.
So long as the final result looks like this:

Both of these are axceptable results.

Excel Workbook
ABCDEFGH
1"PWR" - System Power CommandPWR
2"00"Set System StandbyYesYesYes00!1PWR0049 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 57 52 30 30
3"01"Set System OnYesYesYes01!1PWR0149 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 57 52 30 31
4"02"Toggle between Standby and OnYesYesYes02!1PWR0249 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 57 52 30 32
5"OPC" - Open/Close CommandOPC
6Open or Close the trayYesYesYes!1OPC49 53 43 50 00 00 00 10 00 00 00 06 01 00 00 00 21 31 4F 50 43
7"SDC" - DVD Classification Status noticeSDC
8"00"Unknown/otherNoNoNo00!1SDC0049 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 30
9"01"DVD-VIDEONoNoNo01!1SDC0149 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 31
10"02"DVD-AUDIO(ATS_AOB)NoNoNo02!1SDC0249 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 32
11"03"DVD-AUDIO(ATS_VOB)NoNoNo03!1SDC0349 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 33
12"04"DVD-AUDIO(ATS_AMGM_VOB)NoNoNo04!1SDC0449 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 34
13"05"DVD-VRNoNoNo05!1SDC0549 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 35
14
15"FF"Unknown/otherNoNoNoFF!1SDCFF49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 46 46
16"DB"DYesYesYesDB!1SDCDB49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 44 42
17"PGR" - Progressive CommandPGR
18(No Parameter)NoNoNo
19"DN"Progressive On/Off ToggleNoNoNoDN!1PGRDN49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 47 52 44 4E
20"00"Progressive OffNoNoNo00!1PGR0049 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 47 52 30 30
21"01"Progressive OnNoNoNo01!1PGR0149 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 47 52 30 31
22SetupNoNoNo
Command & Message
Excel Workbook
ABCDEFG
1"PWR" - System Power Command
2"00"Set System StandbyYesYesYes!1PWR0049 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 57 52 30 30
3"01"Set System OnYesYesYes!1PWR0149 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 57 52 30 31
4"02"Toggle between Standby and OnYesYesYes!1PWR0249 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 57 52 30 32
5"OPC" - Open/Close Command
6Open or Close the trayYesYesYes!1OPC49 53 43 50 00 00 00 10 00 00 00 06 01 00 00 00 21 31 4F 50 43
7"SDC" - DVD Classification Status notice
8"00"Unknown/otherNoNoNo!1SDC0049 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 30
9"01"DVD-VIDEONoNoNo!1SDC0149 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 31
10"02"DVD-AUDIO(ATS_AOB)NoNoNo!1SDC0249 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 32
11"03"DVD-AUDIO(ATS_VOB)NoNoNo!1SDC0349 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 33
12"04"DVD-AUDIO(ATS_AMGM_VOB)NoNoNo!1SDC0449 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 34
13"05"DVD-VRNoNoNo!1SDC0549 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 30 35
14
15"FF"Unknown/otherNoNoNo!1SDCFF49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 46 46
16"DB"DYesYesYes!1SDCDB49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 53 44 43 44 42
17"PGR" - Progressive Command
18(No Parameter)NoNoNo
19"DN"Progressive On/Off ToggleNoNoNo!1PGRDN49 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 47 52 44 4E
20"00"Progressive OffNoNoNo!1PGR0049 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 47 52 30 30
21"01"Progressive OnNoNoNo!1PGR0149 53 43 50 00 00 00 10 00 00 00 08 01 00 00 00 21 31 50 47 52 30 31
22SetupNoNoNo
Command & Message



I hope this clarifys the info.
Sorry, but im sure you can see that this is a hard one to explain.
Hopefully having the actual data to work with will help.

Thanks
Daniel.
 
Upvote 0
Hi Vladimir,

I was replying while you replied with the new code.

That code worked great!

I just tried it and it looks like everything worked correctly.

Can you please explain how to change it so the results show in a different range?


Thank you so much.
Daniel
 
Upvote 0
Sorry.

I just read the comments in the code.

Thank you. This makes it very easy to modify as required.

Thank you again.


Daniel.
 
Upvote 0
Daniel,

Please confirm that the result does not depend on values in C:E coulums

And two questions referring to your example:

1. Why there is no result in row 22 with empty A22 and not empty B22, but result is present with the same (for me) conditions in the row 6 with empty A6 and not empty B6?

2. If (No Parameter) text is in A cell then should such row always be ignored with empty cells in result?

Vlad
 
Last edited:
Upvote 0
Vladimir,

Please confirm that the result does not depend on values in C:E columns

That is correct. Only A:B have anything to do with the results. The other cells are just showing what units these commands will work with (these are blu-ray player RS232 commands)


And two questions referring to your example:

1. Why there is no result in row 22 with empty A22 and not empty B22, but result is present with the same (for me) conditions in the row 6 with empty A6 and not empty B6?

After looking at the documentation I believe that row 22 should actually show a result (didn't notice that):
!1PGR

The same as row 6.

So if Column B has a description in it a result should be shown even if column A is empty.

2. If (No Parameter) text is in A cell then should such row always be ignored with empty cells in result?

Yes, that is correct. If (No Parameter) is shown then simply skip this cell regardless of what column B shows.

This may change in the future so it is OK if it shows a result (as it does now)

Is this valid/correct coding?
Code:
 Columns(DESTCOL).Select
  Selection.Delete Shift:=xlToLeft
I added it to the last section of your VBA.

Code:
 ' Copy b() to the destination range
  Rng.Columns(DESTCOL).Resize(, UBound(b, 2)).Value = b()
 Columns(DESTCOL).Select
  Selection.Delete Shift:=xlToLeft


Thanks
Daniel
 
Upvote 0
Daniel, thanks for the explanation, rules are clear now.

Your modification of the code is correct but below it more optimized one.
In the future you can change NOPARAMMODE constant to 1 to process the data with NOPARAM text.

Rich (BB code):

' ZVI:2011-03-20 http://www.mrexcel.com/forum/showthread.php?t=536660
' Version 02: New rules are added
' Version 03: NOPARAMMODE constant is added, two columns output is created
Sub CreateRS232IP()
  
  ' --> Settings, change to suit
  Const DESTCOL$ = "F"                ' The 1st column of the destination range
  Const PREFIX$ = "!1"                ' Output prefix
  Const NOPARAM$ = "(No Parameter)"   ' Keyword of A column (refer to the rules)
  Const NOPARAMMODE& = 0              ' If zero then ignore rows with NOPARAM text, else (not zero) - process it
  Const QT$ = """"                    ' Quote symbol
  ' <-- End of the settings
  
  ' Used types suffixes: & - As Long,  $ - As String
  Dim Rng As Range, a(), b(), i&, r&, hdr$, v$
  
  ' Set input data range Rng
  With ActiveSheet
    Set Rng = .UsedRange.Columns("A")
  End With
  
  ' Copy input data into a()
  a = Rng.Resize(, 2).Value
  
  ' Prepare output array
  ReDim b(1 To UBound(a), 1 To 2)
  
  ' Do main processing
  For r = 1 To UBound(a)
    If VarType(a(r, 1)) = vbString Then
      v = Trim(a(r, 1))
      i = InStr(3, v, QT) ' position of 2nd quote
      If i > 2 Then
        If Left$(v, 1) = QT Then
          If i = Len(v) Then
            ' Extract value, populate b() for F:G column
            v = PREFIX & hdr & Mid$(v, 2, i - 2)
            b(r, 1) = v
            b(r, 2) = RS232IP2(v)
          Else
            ' Extract header
            hdr = Mid$(v, 2, i - 2)
          End If
        End If
      Else
        ' Check NOPARAMMODE and NOPARAM in data
        If NOPARAMMODE <> 0 Then
          If StrComp(v, NOPARAM) = 0 Then
            ' NOPARAM keyword found - populate b() for F:G column without value
            v = PREFIX & hdr
            b(r, 1) = v
            b(r, 2) = RS232IP2(v)
          End If
        End If
      End If
    Else
      If VarType(a(r, 2)) = vbString Then
        If Len(Trim(a(r, 2))) > 0 Then
          ' Cell A is empty but cell B isn't empty - populate b() for F:G column without value
          v = PREFIX & hdr
          b(r, 1) = v
          b(r, 2) = RS232IP2(v)
        End If
      End If
    End If
  Next
  
  ' Copy b() to the destination range
  Rng.Columns(DESTCOL).Resize(, UBound(b, 2)).Value = b()

End Sub

' Modified code of PGC01 and Sandeep.Warrier http://www.mrexcel.com/forum/showthr...hlight=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

Regards,
Vlad
 
Upvote 0

Forum statistics

Threads
1,224,583
Messages
6,179,683
Members
452,938
Latest member
babeneker

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