Posts by hgus393

Re: Copy and paste without clipboard to another book

What about something like this - untested though

Sub Copy()
Dim RngCopy As Range
Dim RngPaste As Range


Set RngCopy = Workbooks("Your book.xls").Sheets("Sheet1").Range("A1:A200")
Set RngPaste = Workbooks("Book to paste.xls").Sheets("Sheet1").Range("A1:A200")
RngCopy.Copy RngPaste
End Sub

Robert

Re: Save Button in VBA

Hello Statsboi,

Try the attached!

Robert

Re: creating your own VBA code

Quote from ShubhamIND

I want to make a data bank of my own in excel under diiferent headings like Company Name, Name, Address,City,State,PIN, Country,Phone,Fax etc.
I want a sheet where different input boxes pop-up and when the user enters the details they keep getting recorded under the headings.PLEASE help!!!

Hi ShubhamIND and welcome!
Could you please show us how far you have gotten? I.e. attach an example?

Robert

Re: To make 'Save' Button to actually save the worksheet using VBA

Hello Statsboi,

Your VBA project is password locked as such I cannot see your code. However, I wrote some code that will probably do what you want, don't know if it is the best way to do this, someone else might have a good idea?
Here goes:

Sub SaveButton()
Dim SaveWkb
Dim Flt As String
Dim FlterInd As Integer
Dim Title As String


On Error GoTo Handleerror


Flt = "Excel files (*.xls),*.xls,"


FlterInd = 1


Title = "Select a location to save"
           
    
SaveWkb = Application.GetSaveAsFilename _
(FileFilter:=Flt, _
FilterIndex:=FlterInd, _
Title:=Title)


If SaveWkb = False Then
        MsgBox "No file was saved."
        Exit Sub
    End If


ActiveWorkbook.SaveAs Filename:=SaveWkb
Handleerror:
     
End Sub

Robert

Re: Send a mail automatically

Quote from Baskent

I have a worksheet in local area network of which some of the cells should be filled by my colleagues when the information is received. But, generally my colleagues are forgetting to do. In the worksheet there is a column where their initials exists. What I required, if possible, to remind them if the cells were not filled within given days. This mail should be sent to the person with initials in the given row and to me.

Thank you for your assistance in advance.

Could you send an example workbook?

Re: Msgbox VBYesNo and then what..

Right I see! Thank you andy for all your help!

Robert

Re: Msgbox VBYesNo and then what..

Quote from Andy Pope

Hi,

Here is an example. You need to test the variable Ans and ask only if needs be.[vba]Sub x()

Dim Ans As Long
Dim lngIndex As Long

For lngIndex = 1 To 10
If Ans <> vbYes Then Ans = MsgBox("Do you really want to continue?" & vbCrLf, vbYesNo)
If Ans = vbNo Then
MsgBox "Quit after " & lngIndex
Exit Sub
End If
Next
MsgBox "Completed"
End Sub[/vba]

Display More

:thanx:
Would using

For lngIndex = 1 To Worksheets.Count

Be a good option for all the worksheets?
/Robert

Re: Msgbox VBYesNo and then what..

Yep that is correct!
Robert

Hello all,

I have a little problem that I hope someone can solve. I have a macro that finds multiple occurences on every sheet in a workbook by using the countif function. If the macro finds a multiple occurence it will colour that cell red and display a message that explains that there are multiple occurences and if the user wants to continue. I have worked out the No part, but what I would like is if the users presses yes then it will ignore all the multiple occurences that exits in all the worksheets. Does anybody know how to do this?
Here my code:

Sub MultiOccurence()
Dim cell As Range
Const Colour = 3
Dim Wks As Worksheet
Dim r As Range
Dim rowc As Long
Dim i As Long
Dim ans As String


Application.ScreenUpdating = False


For Each Wks In ActiveWorkbook.Worksheets
rowc = Application.WorksheetFunction.CountA(Wks.Range("B:B"))
For i = 2 To rowc
Wks.cells(i, 16) = "=COUNTIF(C[-14],RC[-14])"
Next i


Set r = Wks.Range("P2: P" & rowc)


For Each cell In r
Select Case cell.Value
Case Is < 2
cell.Interior.ColorIndex = xlNone
Case Is = ""
cell.Interior.ColorIndex = xlNone
Case Is >= 2
cell.Interior.ColorIndex = Colour
End Select
Next cell
For Each cell In r
If cell.Interior.ColorIndex = Colour Then
ans = Msgbox("Multiple Occurences exit,Do you really want to continue?" & vbCrLf & "Errors are in following Sheets and cells:" & vbCrLf & Wks.Name & " " & cell.Address, vbYesNo)
If ans = vbNo Then
Exit Sub
End If
End If
     Next cell


          Next Wks
Application.ScreenUpdating = True


End Sub

Robert

Re: Creating an automated database

Hi,

Knicked some of Joebbshop code to solve the problem:

Sub TryThisNow()
     
    Dim i As Integer
    Dim Irow As Integer
    Irow = 0
    For i = 0 To 9999
        Irow = i
        Cells(10 + i, 2) = Irow
    Next i
End Sub

Hope this helps!

/Robert

Re: Creating an automated database

Try this!

Sub trythis()


Dim i As Integer
Dim Irow As Integer
Irow = 0
For i = 1 To 9999
Irow = i
Cells(i, 1) = Irow
Next i
End Sub

//Robert

Re: Removing duplicate cells - macro runs slow

Quote from thomach

re your code, you are going to extra work writing the formulas into column C. These formulas (all that remain) also need to recalculate after each row is deleted. Have a look at this code.

Code

Sub DownSelect()
Dim r As Long, LstRow As Long
LstRow = Range("B" & Rows.Count).End(xlUp).Row
For r = LstRow To 2 Step -1
    If WorksheetFunction.CountIf(Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row), Cells(r, 2)) > 1 _
        Then Rows(r).EntireRow.Delete
Next r
End Sub

:yourock: This was an approach I never would have thought of! :thanx: :thanx: :thanx:
Robert

Hello all,

I have account numbers in a column B, there might be more than one occurence in the column. What I am trying to do is to remove these multiple occurences by a countif formula and if the of the countif value is >= 2 then the cell should be deleted. However the macro runs reaaallllly slow. Can anybody see what I am doing wrong?

Sub Duplicates()


Dim rowc As Long
Dim i As Long
Dim cell As Range
Dim r As Range




Range("c1").Value = "CountIF"
rowc = Application.WorksheetFunction.CountA(Range("B:B"))


For i = 2 To rowc
Cells(i, 3) = "=COUNTIF(C[-1],RC[-1])"
Next i


Set r = Range("c2:c" & rowc)
For Each cell In r
Select Case cell.Value
Case Is >= 2
cell.EntireRow.Delete
End Select
Next cell
End Sub

:thanx:
Robert

Re: Moving values from several sheets to one sheet

:thanx: This works fine thank you!!
Robert

Hello all,

I am a stuck. What I am trying to do is transferring values from a column in each sheet to a new sheet in the workbook. I have attached an example of what I would expect the code to do. Does anybody have a clue of how I can do this? :?

Robert

Re: Converting a cell value to a hyperlink

Thanks Norie!
:thanx:

Hello all,

Does anyone know how to create a hyperlink based on a cells value and looping this through a specifeied number of cells?

R

Re: Keep hyperlink when pasting as value?

Send me a mail in swedish explaining what you are trying to do....

Re: Create a &quot;save button&quot; on xls using VBA

Hi,

I could not enter your vba project area as it was password protected but I have taken a quick and dirty approach that works - I guess it would be better with a workbook event ie before close or before save but the skills fail me..

Sub QuicknDirty()


Dim rng As Range
Dim R As Range


Set rng = Range("C14:C23")
For Each R In rng
If R.Value = "" Then
MsgBox "Value has to be entered before saving is possible!", vbInformation
Exit Sub
End If
Next R
End Sub

Robert

Re: Keep hyperlink when pasting as value?

Quote from Obelix

Thanx,
but now I get this message: sorry, but I don't know how that would translate into english.

Translated to English = Compilation Error, undefined variable...

By the way the macro works fine for me!