Posts by Colo

Colo · Jan 27th 2004

Hi mjschukas

You can pass value like this.

'a Cell to a Textbox on the Form
TextBox1.Text = Range("A1").Value

'a Textbox on the form to a Cell.
Range("A1").Value = TextBox1.Text

Colo · Jan 26th 2004

Hi, kpgduras,

Sorry this is NOT an answer...
I've seen the same problems with Excel2000 at other boards(US Jpn). But no one could reply the question.

I'm not sure but try this. After uninstall MS office and remove all related files/folders then, install MS office again.

Colo · Nov 21st 2003

Hi spnz,

From your main menu bar, select Tools>Options, at the Edit tab, you can chage direction.

Colo · Nov 21st 2003

Hi Andy,

I could not grasp the laypot of the worksheet, so I changed the code to the specification which can search titles in the first row. Please try this code and let me have the result.

>Q1 : For the field "Type", if is not only contain API, is will contain empty or other data.
My code judges processing by whether the cell (field Type) is blank.

>Q2 : When i push a button, how do i auto replace all the original naming to the format i want at the same worksheets?
Why don't you insert a Button from View > Toolsbars > Form, and assign the macro named UDSort2?

Code

Option Explicit: Option Base 0


Sub UDSort2()
    Dim col(0 To 2) As Long, arrTitle, ret, i As Long
    Dim lngEnd As Long, buf0, buf1, buf2, tmp


    'Find Title Column
    arrTitle = Array("Seg", "Component", "Type")
    For i = 0 To 2
        ret = Application.Match(arrTitle(i), Rows(1), 0)
        If IsError(ret) Then
            MsgBox arrTitle(i) & " was NOT found at row1"
            Exit Sub
        Else
            col(i) = ret
        End If
    Next
    lngEnd = ActiveSheet.UsedRange.Rows.Count


    'Get each value
    buf0 = Cells(col(0)).Resize(lngEnd).Value    'Seg
    buf1 = Cells(col(1)).Resize(lngEnd).Value    'Component
    buf2 = Cells(col(2)).Resize(lngEnd).Value    'Type


    'Change value
    For i = LBound(buf0) + 1 To UBound(buf0)
        If Not IsEmpty(buf2(i, 1)) Then    'If Type column is NOT empty
            tmp = GetMonitor(buf1(i, 1))
            If Not tmp = vbNullString Then
                buf0(i, 1) = tmp
            Else
                If MsgBox("Seems this data has been changed already..." & vbLf & _
                          "Do you want to continue?", vbYesNo + vbQuestion) <> vbYes Then
                    Exit Sub
                End If
            End If
            buf1(i, 1) = SortComp(buf1(i, 1))
        End If
    Next


    'Put changed value
    Cells(col(0)).Resize(lngEnd).Value = buf0        'Seg
    Cells(col(1)).Resize(lngEnd).Value = buf1        'Component
    Cells(col(2)).Resize(lngEnd).Value = buf2        'Type
End Sub


Function GetMonitor(ByVal strSeq As String) As String
    Dim a, i As Long
    a = Split(strSeq, " ")
    For i = LBound(a) To UBound(a)
        If a(i) Like "*CP" Then GetMonitor = "Monitor " & a(i): Exit Function
    Next
    GetMonitor = vbNullString
End Function


Function SortComp(ByVal strSeq As String) As String
    Dim a, b(0 To 2), i As Long, tmp
    a = Split(strSeq, " ")
    For i = LBound(a) To UBound(a)
        If a(i) Like "*cm" Then
            b(1) = a(i)
            tmp = tmp & i
        End If
        If IsNumeric(Right(a(i), 1)) And Len(a(i)) &gt; 1 Then
            b(0) = Left(a(1), 1) & "-" & Mid(a(1), 2)
            tmp = tmp & i
        End If
        If a(i) Like "*CP" Then
            tmp = tmp & i
        End If
    Next
    For i = LBound(a) To UBound(a)
        If InStr(1, i, tmp, vbTextCompare) = 0 Then b(2) = a(i)
    Next
    SortComp = Join(b)
End Function

Display More

Colo · Nov 20th 2003

Hi Andy,

Assume your worksheet is as follows, please try this code.

Code

Option Explicit


Sub UDSort()
    Dim buf, i As Long
    buf = [A1].CurrentRegion.Value
    For i = LBound(buf) + 1 To UBound(buf)
        If Not IsEmpty(buf(i, 3)) Then
            buf(i, 1) = IIf(GetMonitor(buf(i, 2)) = vbNullString, buf(i, 1), GetMonitor(buf(i, 2)))
            buf(i, 2) = SortComp(buf(i, 2))
        End If
    Next
    [A1].CurrentRegion.Value = buf
End Sub


Function GetMonitor(ByVal strSeq As String) As String
    Dim a, i As Long
    a = Split(strSeq, " ")
    For i = LBound(a) To UBound(a)
        If a(i) Like "*CP" Then GetMonitor = "Monitor " & a(i): Exit Function
    Next
    GetMonitor = vbNullString
End Function


Function SortComp(ByVal strSeq As String) As String
    Dim a, b(0 To 2)
    a = Split(strSeq, " ")
    b(0) = Left(a(2), 1) & "-" & Mid(a(2), 2)
    b(1) = a(0)
    b(2) = a(3)
    SortComp = Join(b)
End Function

Display More

<SCRIPT language=JavaScript src="http://www.interq.or.jp/sun/puremis/colo/popup.js"></SCRIPT><CENTER><TABLE cellSpacing=0 cellPadding=0 align=center><TBODY><TR><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; BORDER-LEFT: #000000 0.5pt solid" bgColor=#0c266b colSpan=6><TABLE width="100%" align=center border=0><TBODY><TR><TD align=left><FONT color=white>Microsoft Excel - Book2.xls</FONT></TD><TD style="FONT-SIZE: 9pt; COLOR: #ffffff; FONT-FAMILY: caption" align=right>___Running: xl2002 XP : OS = Windows Windows 2000 </FONT></TD></TR></TBODY></TABLE></TD></TR><TR><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-LEFT: #000000 0.5pt solid; HEIGHT: 25px" bgColor=#d4d0c8 colSpan=6><TABLE width="100%" align=center border=0 VALIGN="MIDDLE"><TBODY><TR><TD style="FONT-SIZE: 10pt; COLOR: #000000; FONT-FAMILY: caption">(<U>F</U>)ile (<U>E</U>)dit (<U>V</U>)iew (<U>I</U>)nsert (<U>O</U>)ptions (<U>T</U>)ools (<U>D</U>)ata (<U>W</U>)indow (<U>H</U>)elp <A onclick=show_popup(); href="#javascript:void(0)">(<U>A</U>)bout</A></TD><TD vAlign=center align=right><FORM name=formCb755237><INPUT onclick='window.clipboardData.setData("Text",document.formFb078704.sltNb935705.value);' type=button value="Copy Formula" name=btCb873980></FORM></TD></TR></TBODY></TABLE></TD></TR><TR><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-LEFT: #000000 0.5pt solid" bgColor=white colSpan=6><TABLE border=0><TBODY><TR><FORM name=formFb078704><TD style="WIDTH: 60px" align=middle bgColor=white><SELECT onchange="document.formFb078704.txbFb426622.value = document.formFb078704.sltNb935705.value" name=sltNb935705><OPTION value="" selected>E5</OPTION></SELECT></TD><TD align=right width="3%" bgColor=#d4d0c8><B>=</B></TD><TD align=left bgColor=white><INPUT size=80 name=txbFb426622></TD></FORM></TR></TBODY></TABLE></TD></TR><TR><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; BORDER-LEFT: #000000 0.5pt solid; BACKGROUND-COLOR: #d4d0c8" align=middle width="2%"><BR></TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; COLOR: black; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8" align=middle><CENTER>A</CENTER></TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; COLOR: black; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8" align=middle><CENTER>B</CENTER></TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; COLOR: black; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8" align=middle><CENTER>C</CENTER></TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; COLOR: black; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8" align=middle><CENTER>D</CENTER></TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; COLOR: black; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8" align=middle><CENTER>E</CENTER></TD></TR><TR><TD style="BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid; COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8" align=middle width="2%"><CENTER>1</CENTER></TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; BORDER-LEFT: #000000 0.5pt solid; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ccffcc; TEXT-ALIGN: left">Seg</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ccffcc; TEXT-ALIGN: left">Component</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ccffcc; TEXT-ALIGN: left">Type</TD><TD style="BORDER-RIGHT: #d4d0c8 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #d4d0c8 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: right"> </TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #d4d0c8 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: right"> </TD></TR><TR><TD style="BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid; COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8" align=middle width="2%"><CENTER>2</CENTER></TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; BORDER-LEFT: #000000 0.5pt solid; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: left">MB</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: left">700cm 600CP D1 DLC</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: left">API</TD><TD style="BORDER-RIGHT: #d4d0c8 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #d4d0c8 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: right"> </TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #d4d0c8 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: right"> </TD></TR><TR><TD style="BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid; COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8" align=middle width="2%"><CENTER>3</CENTER></TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; BORDER-LEFT: #000000 0.5pt solid; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: left">MB</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: left">500cm 300CP K2 DDPA</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: left">API</TD><TD style="BORDER-RIGHT: #d4d0c8 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #d4d0c8 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: right"> </TD><TD style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 9pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #d4d0c8 0.5pt solid; FONT-FAMILY: Verdana; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: right"> </TD></TR><TR><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #808080 0.5pt solid; BORDER-LEFT: #000000 0.5pt solid; BORDER-BOTTOM: #000000 0.5pt solid; BACKGROUND-COLOR: #d4d0c8" colSpan=6><TABLE width="100%" align=left VALIGN="TOP"><TBODY><TR><TD style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #808080 0.5pt solid; BORDER-LEFT: #000000 0.5pt solid; WIDTH: 120pt; BORDER-BOTTOM: #000000 0.5pt solid; BACKGROUND-COLOR: #ffffff" align=left><U>Sheet1</U></TD><TD> </TD></TR></TBODY></TABLE></TD></TR></TBODY></TABLE><BR><FONT color=#339966 size=1>[HtmlMaker 2.41] </FONT><FONT color=#339966 size=1>To see the formula in the cells just click on the cells hyperlink or click the Name box</FONT><BR><FONT color=red size=1>PLEASE DO NOT QUOTE THIS TABLE IMAGE ON SAME PAGE! OTHEWISE, ERROR OF JavaScript OCCUR.</FONT></CENTER>

Colo · Nov 20th 2003

Hi Andy,

Regarding to your sample data, it can be changed by the following code,
But I must ask you something...

Q1:Is D1 is located in same place?
Q2:Is there any regulations? (Eg, the data had always cm, CP and CLC...something like this)

Sub Test()
MsgBox ChangeTomyFormat([A1])
End Sub

Function ChangeTomyFormat(ByVal rng As Range) As String
Dim buf, ret, tmp()
buf = Split(rng.Value, " ")
ReDim tmp(UBound(buf))
tmp(0) = Left(buf(2), 1) & "-" & Mid(buf(2), 2)
tmp(1) = buf(0)
tmp(2) = buf(3)
tmp(3) = buf(1)
ChangeTomyFormat = Join(tmp)
End Function

Colo · Sep 26th 2003

Oh Neale was do fast for me...

Okay, here is just my suggestion for cheking entry and how to get previous month.

Code

Sub Macro1()
    Dim i As Long, blnFlg As Boolean, dat As Date
    
ReInput:
    month1 = InputBox("Enter NEW QUARTER(3 MONTH), EXAMPLE: Oct", "Current Month")
    month1 = Application.WorksheetFunction.Proper(month1)


    ' Check for entry
    For i = 1 To 12
        dat = DateSerial(Year(Date), i, 1)
        If month1 = Format(dat, "mmm") Then
            blnFlg = True
            Exit For
        End If
    Next


    If Not blnFlg Then
        MsgBox "No such Month, please confirm your entry."
        GoTo ReInput
    End If


    'Get pre month
    pmonth = Format(dat - 1, "mmm")
    
    monthsum = month1 & " total"
    X = formula(monthsum)
    ''''*SOME CODE HERE*''''


End Sub

Display More

Colo · Sep 26th 2003

Hi,

All you have to do is PASS the value of monthsum as an argument as follows.

Code

Function formula(ByVal monthsum As String)

Colo · Jun 7th 2003

Hi Dave, I just wanna say new OzGrid banner is cool! Good job! :tumble:

Colo · May 30th 2003

Hi all, Just FYI :))

Worksheet Name:
=MID(CELL("filename",$A$1),FIND("]",CELL("filename",$A$1))+1,31)

BookName:
=MID(CELL("filename"),FIND("[",CELL("filename"))+1,FIND("]",CELL("filename"))-FIND("[",CELL("filename"))-1)

Colo · Mar 27th 2003

Hi, Pls try this.

Code

Sub Test()
    'ColorIdx of RED is 3
    MsgBox CountByColor([A1:A100], 3)
End Sub


Function CountByColor(ByVal rng As Range, ByVal ColorIdx As Long) As Long
    Dim lngCnt As Long, c As Range
    For Each c In rng
        If c.Interior.ColorIndex = ColorIdx Then lngCnt = lngCnt + 1
    Next
    CountByColor = lngCnt
End Function

Display More

Colo · Feb 19th 2003

Hi superexl!

Place the code below in std module,and pleas try this.

Code

Sub ExtractTheContents()
Dim wsRet As Worksheet, ws As Worksheet
Set wsRet = Sheets.Add(after:=Sheets(Sheets.Count))
wsRet.[A1:B1].Value = Array("Value", "Sheet's Name")
For Each ws In Worksheets
    If Not ws.Name = wsRet.Name Then
        With wsRet.[A65536].End(xlUp).Offset(1)
            .Value = ws.[A1].Value 'Suit your needs
            .Offset(, 1).Value = ws.Name
        End With
    End If
Next
End Sub

Display More

Colo · Feb 18th 2003

Hi Dave, No problem. No need to say sorry. Similar code! LOL

Hi Manfred,
I think, I have thought the shapes must be word art from Rennie's post. (Dave might have)

Colo · Feb 18th 2003

Hi Rennie,
I've never used Word Art, but please try this code.

Sub Change_Text()
Dim ws As Worksheet, shp As Shape
For Each ws In Worksheets
For Each shp In ws.Shapes
If shp.Type = msoTextEffect Then
shp.TextEffect.Text = Sheets(1).[A1].Value
End If
Next
Next
End Sub

Colo · Feb 12th 2003

Hi Joel!

it is empty?? Select Userform1(or 2 or 3) from "Project Window" of VBE, and right click then select "View Code".
I think it's one of correct ways.:)

Colo · Feb 8th 2003

at 15:31. and same time. LOL

Colo · Feb 8th 2003

Hi hutchval, like this?

ActiveSheet.Pictures.Insert("C:\PlatMaps\" & [a1].value & ")"

Colo · Feb 8th 2003

Hi, pls change like this!

ActiveWorkbook.SaveAs Filename:=activecell.Value

Colo · Jan 31st 2003

Please remove <br from URL.

Colo · Jan 31st 2003

Plase have a look @ the link below.
And click "Send this code to the VBE"
HTH.

http://www.interq.or.jp/sun/puremis/colo/code/010.htm

Posts by Colo

VBA : forms...

Opening Excel

[Solved] Very silly question!!!

Access: VBA How to changing the cell location ?

Access: VBA How to changing the cell location ?

Access: VBA How to changing the cell location ?

[Solved] VBA: How to bring a value over to function()

[Solved] VBA: How to bring a value over to function()

Cool new banner

[Solved] Sheet tab name to cell on sheet

Counting cells of different color

extract the contents

Changing all text properties of Shapes in a workbook [SOLVED

Changing all text properties of Shapes in a workbook [SOLVED

Userform Code

Insert a picture

Insert a picture

Save file based on active cell

Excel worksheet on Web

Excel worksheet on Web