Posts by smuzoen
-
-
Re: output to empty cell range..
I am assuming you have another function called IsAlphaNumeric? This determines if the string is composed of only alphabet (a-z) and/or numbers? I assume you are trying to write to Sheet2 in column L? If no to any of these then you need to be more specific or supply a sample workbook - you could try something like
Code
Display MoreFunction CountWords(txt) Dim arr() As String Dim i As Long, lastRow As Long arr = Split(txt, " ") 'Find next free row in Column L lastRow = Sheet2.Cells(Rows.Count, "L").End(xlUp).Row + 1 'iterate through the array of strings For i = LBound(arr) To UBound(arr) If Len(arr(i)) = 8 Or Len(arr(i)) = 9 Then 'Call another function to determine if string is alphanumeric If IsAlphaNumeric(arr(i)) Then 'Write data to Sheet 2 Column L Sheet2.Range("L" & lastRow) = arr(i) lastRow = lastRow + 1 End If End If Next End Function
-
Re: Converting Data into number Data
Where or how do you get the value in the first place - is it an import from a file? Unusual character to have in the cell. As cytop said you have ASCII 160 - if you want the specific format you could
=TEXT(SUBSTITUTE(SUBSTITUTE(B3,CHAR(160),"")," ",""),"#,##00")However this is a text - cytop has a better solution in that you should format the cell.
-
Re: Color Macro $30
Just as an option to make the code nice and succinct and promote reuse of code
Code
Display More'================================================================================ 'Colour My Cells 'Copyright (C) 2014 Smallman 'This program is free software: you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published by 'the Free Software Foundation GPLv3 'This program is distributed in the hope that it will be useful, 'but WITHOUT ANY WARRANTY; without even the implied warranty of 'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 'GNU General Public License for more details. 'For a copy of the GNU General Public License 'see http://www.gnu.org/licenses/ '================================================================================ Option Explicit 'Constants for the various colours Const BLUE = 16711680 Const RED = 255 Const GREEN = 65280 Const NONE = -4142 Sub BlueThrough() 'Turns the slection Blue if there is more than 1 cell selected Call ColourMe(BLUE) End Sub Sub RedFaster() 'Turns the slection Blue if there is more than 1 cell selected Call ColourMe(RED) End Sub Sub Greeny() 'Turns the slection Blue if there is more than 1 cell selected Call ColourMe(GREEN) End Sub Sub GotNothing() 'Turns the slection Blue if there is more than 1 cell selected Call ColourMe(NONE) End Sub Sub ColourMe(chosenColour As Long) Dim var As Variant Dim i As Long 'Turns the slection chosed colour if there is more than 1 cell selected var = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal) 'Boarder process and trap for only 1 cell selected. If Selection Is Nothing Then MsgBox "Select something" Else Selection.FormatConditions.Delete Selection.Interior.Color = chosenColour For i = LBound(var) To UBound(var) With Selection.Borders(var(i)) .ThemeColor = 1 .TintAndShade = -0.14996795556505 .Weight = xlThin End With Next i End If End Sub
-
Re: Color Macro $30
Could you succinctly and clearly outline what further work has to be done to finalise this development? Does the code posted by Smallman satisfy yor requirements. ? If not what is the problem with the current code? To save a lot of time reading 30+ posts if you could briefly and clearly state what remains to be done, what modifications to the existing code are required to satisfy your requirements then perhaps this development may be finalised.
-
Re: how to crate Login form in Excel
Just a few notes - Excel security is extremely poor - if you are storing very sensitive information then I would not recommend Excel as a potential solution for you. However...for the "average user" it would probably suffice. If all the information is stored within Excel, even if the sheet is hidden (or very hidden) and it is of a sensitive nature, then password protecting the workbook would be required. However the problem is Excel and security - to break the password is not difficult but as previously stated...for keeping out the average user it may suffice. It depends on how personal the information is that you intend to record within the document.
As with any problem - consider if the tools are adequate for your requirements. -
Re: Counting with multiple criteria without user pivot tables
Have to agree with Smallman - another option is Sumproduct - why make it difficult unless you particularly want to learn VBA or make this an exercise in VBA coding.
If I can offer you one piece of advice - if the Result table is going to be used elsewhere as a source of data ditch the merged cells - merged cells are evil and will cause you nothing but grief. Merged cells should be banned (IMO)Usage Sumproduct
=SUMPRODUCT(--($B$4:$B$14="A"),--($C$4:$C$14="buy"),--($D$4:$D$14=$B$18))
See attached workbook -
Re: Userform edit file multirows
Exactly as Roy said - you are getting errors because RowFound1,RowFound2 etc have no value so
These variables "appear to be declared" but never assigned a value - if excel does not know what row "RowFound1" refers to how can the value from the textbox be entered into the worksheet. In actual fact these variables are NOT declared as far as the code is concerned. Is this just cut and pasted from some other code? Did they assign values somewhere to these variables (and these variables should be declared within the Button Click event not outside as Roy has already pointed out). You probably need to get back to some basics and understand what is going on with the code. -
Re: Macro won't stop creating zipped files
Without seeing the workbook you have a loop
Depending on the length of Column C you have the code for creating the zip file in a loop - that is why you ar getting multiple zip files created - the code for creating the zip files is within a loop - any reason for that? Why put directory into array FName then test if it is an array? Have you cut and pasted this code from somewhere? You loop variable is I then you reset the value of loop variable and then change its value which is really poor programming practice. To tell you the truth it is not the greatest bit of code. -
Re: Subtracting from time
If you type in A1 - "1 am"
Type in B1 - "9 am"
Type in C1 "=B1 - A1"
Format C1 as hh:mm - Result will be 8:00 (representing 8 hours)
Dont use the "" - just what is inside the " "Google is your friend - http://office.microsoft.com/en-us/excel-help/add-or-subtract-time-HA102809662.aspx
-
-
Re: move several columns and sort according to the one particular column
Try - See attached workbook - if I understand your logic the following should do what you require
Code
Display MoreOption Explicit Enum position Left Right End Enum Sub CheckMatches() Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet Dim arr1 As Variant, arr2 As Variant Dim k As Long, pos As Long Set ws1 = Worksheets("Sheet1"): Set ws2 = Worksheets("Sheet2"): Set ws3 = Worksheets("Sheet3") ws3.Range("A2").Resize(ws3.Cells(Rows.Count, "A").End(xlUp).Row, ws3.Cells(1, Columns.Count).End(xlToLeft).Column).Clear 'get Data into arrays arr1 = Application.Transpose(ws1.Range("A2:A" & ws1.Cells(Rows.Count, "A").End(xlUp).Row)) arr2 = Application.Transpose(ws2.Range("A2:A" & ws2.Cells(Rows.Count, "A").End(xlUp).Row)) For k = LBound(arr1) To UBound(arr1) If Not IsError(Application.Match(arr1(k), arr2, False)) Then pos = Application.Match(arr1(k), arr2, False) Call CopyAllData(k, pos, ws1, ws2, ws3) arr2(pos) = vbNullString Else Call CopySingleData(k, ws1, ws3, Left) End If Next pos = ws3.Cells(Rows.Count, "A").End(xlUp).Row + 1 For k = LBound(arr2) To UBound(arr2) If arr2(k) <> vbNullString Then Call CopySingleData(k, ws2, ws3, Right, pos) pos = pos + 1 End If Next End Sub Sub CopyAllData(index1 As Long, index2 As Long, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet) ws1.Range("A" & index1 + 1).Resize(, 11).Copy ws3.Range("A" & ws3.Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats ws2.Range("A" & index2 + 1).Resize(, 11).Copy ws3.Range("M" & ws3.Cells(Rows.Count, "A").End(xlUp).Row).PasteSpecial Paste:=xlPasteValuesAndNumberFormats End Sub Sub CopySingleData(index1 As Long, ws As Worksheet, ws3 As Worksheet, side As position, Optional pos As Long) ws.Range("A" & index1 + 1).Resize(, 11).Copy If side = Left Then ws3.Range("A" & ws3.Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Else ws3.Range("M" & pos).PasteSpecial Paste:=xlPasteValuesAndNumberFormats End If End Sub
-
Re: move several columns and sort according to the one particular column
And if there is no match the row is moved to its own row on sheet 3? If no match of data on Sheet 1 then copy to left side of Sheet 3 and if no data match on Sheet 2 then move to Right side of Sheet3? Is that correct?
-
Re: hard queston about vb
You cannot do that - you could open the workbook containing the worksheet via vba code.
CodeDim wb As Workbook Dim ws As Worksheet Set wb = Workbooks.Open("C:\Temp\Book2.xlsx") Set ws = wb.Worksheets("Mainreport") wb.Activate If Me.TextBox51.Text <> "" Then ....
However if the value does not exist on VLookUp you will get an error so you will need to use something like -
Re: Excel VBA With Range --- End With string manupulation help
QuoteIf I put MsgBox .value inside the block it comes up with type miss match error.
How are you returning a value from a MsgBox?Quoteget rid of any "," at the end of all strings
Quotereduce the font size by 1pt (now its
if the lenght of the string is over 43
Test for length with (you would probably have to loop through range)Quotesplit up the text to different cells if the string lenght is over 43 and there is a coma in the string and the adjacent cell to the right is empty
I am using static ranges however you will get the point - I assume you want it split at comma (and assume only one comma) -
Re: Search and Replace text
Just checking if you want to proceed with work or would you like to have the thread closed. No problem if you don't want to proceed.
-
Re: vba Binary code to read text file & search particular word & amount associated wi
You don't have a binary file however you can open a text file for Binary Access as snb has done (or Sequential/Random access). As cytop said you either have a binary file or a text file - they are NOT the same thing. There are certain advantages to binary files which you can find with Google. Why you want this opened for binary access I do not know. To do what you want you can open the text file and test each line to see if your name is present then use a regular expression to write out the results. See attached workbook. I have only used a very basic regular expression pattern however again Google is your friend is you want to be more specific wrt currency format.
Code
Display MoreOption Explicit Sub ReadTextFile() Dim fName As String Dim iFileNum As Integer Dim buffer As String Const USERNAME = "Rahaman" 'Change to location of your text file fName = "C:\temp\test.txt" If Len(Dir$(fName)) = 0 Then MsgBox "File does not exist", vbCritical Exit Sub End If iFileNum = FreeFile() Open fName For Input As iFileNum Do While Not EOF(iFileNum) Line Input #iFileNum, buffer If InStr(buffer, USERNAME) > 0 Then Call WriteToSheet(buffer, USERNAME) End If Loop Close iFileNum End Sub Sub WriteToSheet(data As String, nameStr As String) Dim regex As Object, regMatch As Object Set regex = CreateObject("vbscript.regexp") With regex .MultiLine = True .Global = True .IgnoreCase = True .Pattern = "\$[ 0-9,.]*" End With Set regMatch = regex.Execute(data) If regex.test(data) Then Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1) = nameStr Range("B" & Cells(Rows.Count, "A").End(xlUp).Row) = regMatch(0) End If End Sub
-
Re: I want to create labelling by using macro kindly help
I have changed this so that you enter the start label and then enter the final NUMBER of the label - e.g. Starting Label A0006, Final Number 600 - see attached workbook
Code
Display MoreOption Explicit Sub AddLabels() Const LABELROWCOUNT = 9 Const LABELCOLUMNCOUNT = 6 Dim textToAdd As String, firstLetter As String, finalNo As String Dim startNo As Long, endNo As Long Dim k As Integer, j As Integer, i As Integer, pageNo As Integer, startRow As Integer startRow = 2 textToAdd = InputBox(Prompt:="Enter the Starting label e.g. A0001", _ Title:="ENTER THE STARTING LABEL") finalNo = InputBox(Prompt:="Enter the Ending label NUMBER e.g. 65", _ Title:="ENTER THE LAST LABEL NUMBER") firstLetter = Left$(textToAdd, 1) startNo = CLng(Mid(textToAdd, 2, Len(textToAdd) - 1)) endNo = CLng(finalNo) 'calculate pages required pageNo = Application.WorksheetFunction.RoundDown(endNo / (LABELROWCOUNT * LABELCOLUMNCOUNT), 0) + 1 For i = 1 To pageNo For k = 1 To LABELROWCOUNT For j = 1 To LABELCOLUMNCOUNT Cells(startRow, j * 2) = Left(UCase(firstLetter) & String(Len(textToAdd) - Len(CStr(startNo)), "0"), _ Len(textToAdd) - Len(CStr(startNo))) & CStr(startNo) If startNo = finalNo Then GoTo finalSub startNo = startNo + 1 Next startRow = startRow + 2 Next startRow = startRow + 1 Next finalSub: MsgBox "Labels Completed", vbInformation End Sub
-
Re: I want to create labelling by using macro kindly help
Will there always be a letter at beginning of label? I can change the code so you enter start number and end number. Just let me know if format of label always has a letter at beginning.
-
Re: Search and Replace text
You can upload a sample workbook when you create a post. When you post to thread Select "Go Advanced" and select your workbook and attach to the post. I will PM my email address and you can send the workbook by email if you prefer. The 10% must be paid to Ozgrid via PayPal before any solution can be developed. Once you have paid the 10% please confirm by posting into thread that it has been paid. The time frame you quoted is fine. It is late here so I will check thread in morning. I will PM my email to you now.