Posts by Justin Doward

HI O.

I have added some basic functionality to your form to give some ideas, note that the paste offset is out sometimes due to the merged cells (I think) so unmerge them to fix it.

Not really sure if it is what you are after, but there is not much there to work with at this point.

Book31 edit.xlsm

Justin

I agree, but the thread exists and hopefully someone else might obtain benefit from it

HI Carim,

Your macro was returning 1920 for the year, not sure how to fix it formula wise but the cDate solves the problem once you feed it a format it recognises. I modified your code as follows:

Sub DateFixerV3()
Dim MyStr As String
Dim r As Range
For Each r In Range("A2:A4")
MyStr = Replace(r.Text, ".", "/", 1)
r.Offset(0, 6) = CDate(MyStr)
Next r
End Sub

HTH

Justin

Hi WH,

It probably depends where the hold-up is occurring, if it is during the copy and paste of the ranges then you could try converting them to arrays and then moving the values which should speed things up as outlined in this video:

If the hold-up is due to the pasting and calculating so many formulas, then do you really need to have the formulas? can you do the calculation and just paste the values or is a user going to be modifying the sheet later? You might be able to use a vba change event for the page to return a value rather than pasting the formulas in the sheet.

If you post an example of your data I could test the array idea, or you could just comment out the formula paste and use the timer see how long it takes without the formula portion of the code.

HTH

Justin

This is an alternative approach using advanced filter and a hidden sheet,

Note that you do not have to return all 23 rows if you don't want to, if you change the headers on the hidden sheet in the range from D:Z to just the headers you want returned in the listbox autofilter will limit the return to those headers. The criteria for the filter are on the hidden sheet from A:B, just change the headers there to whatever additional criteria you wish to add and adjust the ranges to suit.

You could also do this with a temp sheet, and delete the sheet each time as Roy has done and this would be more streamlined (and a smaller sized workbook) but you would need to copy the headers to the temp sheet each time so for now I just used the hidden sheet, the only real benefit is that you do not need to press the button between selections.

VBA MYDATA - EDIT.xlsm

Regards

Justin

Hi JO,

Try the method in the attachment, this method is the only way I know to achieve what you are after i.e. load the data into an array and then set that array to be the list for the listbox.

Sub FIllLB()


Dim MyArr As Variant
Dim ws As Worksheet
Set ws = shMYDATA
MyArr = ws.Range("A1").CurrentRegion
UserForm1.MyListbox.List = MyArr
UserForm1.Show


End Sub

VBA MYDATA - LBFILL.xlsm

Next time just upload the code in the excel file if you want someone to look at the code you are using in context.

Cheers

Justin

Hi BW,

I have not tested the idea but you could try a combination of these:

1. Ask the user you are giving the file to for the computer name they are going to use the file on the use a line in the code like:

if Environ$("computername") <> "Correct Name" then

2. run code as described here:

http://www.vbaexpress.com/kb/getarticle.php?kb_id=540

which will delete the file.

or you could identify the PC in other forms eg:

https://www.mrexcel.com/board/…uter-attritbutes.1054445/

Otherwise you could simply write into the code that it will not work or will disable the file in other ways (such as deleting ranges and saving the workbook, if it is not on a computer with the correct name, bios serial number or whatever you choose.

This combined with some password to protect the code and very hidden sheets etc would probably be the best you could get.

If you do work this out let me know, I would be interested in the solution.

Regards

Justin

Hi GE,

I had a look at your problem but cannot fathom what your needs are, can you clarify what you actually want to happen?

If you include a sheet with a before and after sort of theme it might help, i.e I click this button and this information goes here, etc...

Regards

Justin

Hi Ajith,

Thank you for the feedback, glad it worked!

Cheers

Justin

Hi Mubby,

Below are my thoughts based on your post, note that I am not a moderator and feel free to wait for Rob or one of the others to comment.

If you are interested in getting a job done, rather than learning in the forums, check out the consultancy link:

https://www.ozgrid.com/consultancy

OR

Place the post in the HIre Help forum:

HIRE HELP

I believe the second will be cheaper but it would depend on your budget, how quickly you need something built, and how much customisation is required. What you appear to be looking for is simple enough but time consuming to tweak everything, you also need to consider how you are going to maintain it into the future if you have no VBA experience yourself.

If you are not in a hurry, and are looking to learn VBA, post your workbook as you come to discrete problems and people here will point you in the right direction.

Looking at your code there are a few errors, you define X as the last used row in A then redefine X as the last used row in B (so X will be the last used row in B), you then loop through the A column and refill every text box whenever you get a match with textbox31 (which I assume is your search string) you really need to list the results as they are found and this is usually done using a listbox or combobox.

As Roy states, a loop search is not the most efficient search method it will do for small databases (up to a few thousand entries, more if you array your data first). The built in Autofilter function of excel can be used as an efficient VBA search, I am not sure what mechanism Roy is using in his linked database.

A loop is a more efficient way of filling your textboxes though, for example:

For Y = 6 To X
Me.Controls("TextBox" & Y - 5).Text = Sheet1.Cells(Y, 1).Value
Next Y

would replace lines 8 to 34 in your code.

As you do not reference a userform in your code, I assume you do not actually have a working form at this point? Feel free to upload what you are working on if you feel like going in that direction.

Regards

Justin

It should work, did you change the directory in both spots in the code?

I have changed the code slightly in the attachment so there is only one spot where you need to change the directory. Are the picture files on you local drive? The code will work for a local drive, it should also work for a networked drive, if it is a web address it will probably require completely different code, test the attachment with a local drive and let me know if it works.

Regards

Justin

Hi Ajith,

This works on the example you sent, change the directory as appropriate:

Sub Picture()
Dim pictname As String, PictnPath As String
Dim pastehere As Range
Dim pasterow As Long
Dim x As Long
Dim lastrow As Long

lastrow = Worksheets("sheet1").Range("B1").CurrentRegion.Rows.Count
x = 2
For x = 2 To lastrow
Set pastehere = Cells(x, 1)
pasterow = pastehere.Row
Cells(pasterow, 1).Select 'This is where picture will be inserted

pictname = Cells(x, 2) 'This is the picture name
PictnPath = Dir("D:\Pictures\" & pictname & ".jpg")
If Len(PictnPath) > 0 Then
ActiveSheet.Pictures.Insert("D:\Pictures\" & pictname & ".jpg").Select  'Path to where pictures are stored

With Selection

.Left = Cells(pasterow, 1).Left
.Top = Cells(pasterow, 1).Top

.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 55#
.ShapeRange.Width = 55#
.ShapeRange.Rotation = 0#
End With
End If
Next

End Sub

Let me know how you go.

Justin

That is a text file of the code, I will have a look at a workbook that has the code in context and is working if you wish to upload it. I can get some example jpegs so you don't need to provide those.

HI Ajith,

If you want to load a working example of your current worksheet, I can have a look at modifying to avoid the errors.

Regards

Justin

Hi Ajith,

Don't forget to wrap your code in code tags, and read the rules to ensure you get an answer.

You should just be able to use something like:

For x = 2 To lastrow

If Dir("\\C:\Users\ajith.nair\Desktop\Range\photos for new range Q1\" & pictname & ".jpg")  = "" Then Goto MyNext

Relevant code

MyNext:
Next x

Regards

Justin

Also the code you have shown is not going to work, it appears to be the combobox change event combined with the userform initialize event but with the second sub name removed.

you should be able to replace your code above with something like:

Private Sub UserForm_Initialize()
Dim MyArr As Variant
Dim ws As Worksheet: Set ws = Sheet1
MyArr = ws.Range("A1").CurrentRegion
Me.ComboBox1.List = MyArr
End Sub

Private Sub ComboBox1_Change()
Dim i As Long, x As Long
Dim ws As Worksheet: Set ws = Sheet1
i = Me.ComboBox1.ListIndex + 1
For x = 1 To 26
Me.Controls("TextBox" & x) = Me.ComboBox1.Column(x)
Next x
End Sub

Justin

Hi AJ,

You need to attach an excel worksheet with an example of your data, not a PDF and not a docx. If you have sensitive data just make a backup copy with all the data deleted and add some example data. Nobody is going to remake your form and create example data for you.

Justin

HI AJ,

The code works fine on an example form with the two textboxes on it, if you want to load an example of what you are working with I will incorporate the code and we can get it working.

The If statement works as shown if it is on a single line, however if you have multiple lines of code you need to have an enter after THEN and include an END IF statement.

I tried downloading the example sheet you have but it is a .docx format and does not open, hopefully it is not a virus.

Regards

Justin

Hi AJ,

You need to change the text in the textbox to a date value using cdate, something like the following should work:

Private Sub TextBox1_AfterUpdate()
If Me.TextBox2.Value <> Empty Then GoTo MyExit


Select Case CDate(Me.TextBox1.Text) - Date


Case Is > 6
GoTo MyExit
Case 0 To 5
Me.TextBox1.BackColor = vbYellow
Case Is < 0
Me.TextBox1.BackColor = vbRed


End Select
MyExit:
MsgBox "There are " & CDate(Me.TextBox1.Text) - Date & " days until due."
End Sub

Based of your text, I have not looked at your attachment sorry, I did not realise it was there.

Also note that if you move the date value to and from the textboxes to cells etc, and use the format command to format them, it is a safe way to ensure you do not lose the correct date through some excel autoformatting.

Something like:

format(cdate(me.textbox1.text), "Short Date")

Hi PR,

I think I can safely say that your requirement is not clear. I cannot workout whether you intend to have an array in the cell (eg separated by a comma or other) or you mean you want to compare the value in column L against an array and if it matches then put PC in column O.

The first objective could be achieved using a simple vlookup formula against a table of values.

You should make your sheet representative of what you are working with, and include a before and after example.

Regards

Justin